

;	RRRRRRRRRRRR      TTTTTTTTTTTTTTT      SSSSSSSSSSSS
;	RRRRRRRRRRRR      TTTTTTTTTTTTTTT      SSSSSSSSSSSS
;	RRRRRRRRRRRR      TTTTTTTTTTTTTTT      SSSSSSSSSSSS
;	RRR         RRR         TTT         SSS
;	RRR         RRR         TTT         SSS
;	RRR         RRR         TTT         SSS
;	RRR         RRR         TTT         SSS
;	RRR         RRR         TTT         SSS
;	RRR         RRR         TTT         SSS
;	RRRRRRRRRRRR            TTT            SSSSSSSSS
;	RRRRRRRRRRRR            TTT            SSSSSSSSS
;	RRRRRRRRRRRR            TTT            SSSSSSSSS
;	RRR   RRR               TTT                     SSS
;	RRR   RRR               TTT                     SSS
;	RRR   RRR               TTT                     SSS
;	RRR      RRR            TTT                     SSS
;	RRR      RRR            TTT                     SSS
;	RRR      RRR            TTT                     SSS
;	RRR         RRR         TTT         SSSSSSSSSSSS
;	RRR         RRR         TTT         SSSSSSSSSSSS
;	RRR         RRR         TTT         SSSSSSSSSSSS




;	PPPPPPPPPPPP            111               111
;	PPPPPPPPPPPP            111               111
;	PPPPPPPPPPPP            111               111
;	PPP         PPP      111111            111111
;	PPP         PPP      111111            111111
;	PPP         PPP      111111            111111
;	PPP         PPP         111               111
;	PPP         PPP         111               111
;	PPP         PPP         111               111
;	PPPPPPPPPPPP            111               111
;	PPPPPPPPPPPP            111               111
;	PPPPPPPPPPPP            111               111
;	PPP                     111               111
;	PPP                     111               111
;	PPP                     111               111
;	PPP                     111               111
;	PPP                     111               111
;	PPP                     111               111
;	PPP                  111111111         111111111
;	PPP                  111111111         111111111
;	PPP                  111111111         111111111



;	RRRRRRRRRRRR      TTTTTTTTTTTTTTT      SSSSSSSSSSSS
;	RRRRRRRRRRRR      TTTTTTTTTTTTTTT      SSSSSSSSSSSS
;	RRRRRRRRRRRR      TTTTTTTTTTTTTTT      SSSSSSSSSSSS
;	RRR         RRR         TTT         SSS
;	RRR         RRR         TTT         SSS
;	RRR         RRR         TTT         SSS
;	RRR         RRR         TTT         SSS
;	RRR         RRR         TTT         SSS
;	RRR         RRR         TTT         SSS
;	RRRRRRRRRRRR            TTT            SSSSSSSSS
;	RRRRRRRRRRRR            TTT            SSSSSSSSS
;	RRRRRRRRRRRR            TTT            SSSSSSSSS
;	RRR   RRR               TTT                     SSS
;	RRR   RRR               TTT                     SSS
;	RRR   RRR               TTT                     SSS
;	RRR      RRR            TTT                     SSS
;	RRR      RRR            TTT                     SSS
;	RRR      RRR            TTT                     SSS
;	RRR         RRR         TTT         SSSSSSSSSSSS
;	RRR         RRR         TTT         SSSSSSSSSSSS
;	RRR         RRR         TTT         SSSSSSSSSSSS




;	PPPPPPPPPPPP            111               111
;	PPPPPPPPPPPP            111               111
;	PPPPPPPPPPPP            111               111
;	PPP         PPP      111111            111111
;	PPP         PPP      111111            111111
;	PPP         PPP      111111            111111
;	PPP         PPP         111               111
;	PPP         PPP         111               111
;	PPP         PPP         111               111
;	PPPPPPPPPPPP            111               111
;	PPPPPPPPPPPP            111               111
;	PPPPPPPPPPPP            111               111
;	PPP                     111               111
;	PPP                     111               111
;	PPP                     111               111
;	PPP                     111               111
;	PPP                     111               111
;	PPP                     111               111
;	PPP                  111111111         111111111
;	PPP                  111111111         111111111
;	PPP                  111111111         111111111

	.MACR	..	QQ1,QQ2	;OPCODE DEFINITION FOR INTERPRETER
	.WORD	QQ2
  	QQ1=OPCODE
		OPCODE=OPCODE+1


	.ENDM

OPCODE	=	-128.	;SET OPCODE START TO -128

TABL2:	..	PPADDF,ADDF	;FLOATING +
	..	PPADDI,ADDI	;INTEGER +
	..	PPSUBF,SUBF	;FLOATING -
	..	PPSUBI,SUBI	;INTEGER -
	..	PPRSBF,RSUBF	;FLOATING REVERSE -
	..	PPRSBI,RSUBI	;INTEGER REVERSE -
	..	PPMULF,MULF	;FLOATING *
	..	PPMULI,MULI	;INTEGER *
	..	PPDIVF,DIVF	;FLOATING /
	..	PPDIVI,DIVI	;INTEGER /
	..	PPRDVF,RDIVF	;FLOATING REVERSE /
	..	PPRDVI,RDIVI	;INTEGER REVERSE /
	..	PPPWRF,PWRF	;FLOATING ^
	..	PPPWRI,PWRI	;INTEGER ^
	..	PPRPWF,RPWRF	;FLOATING REVERSE ^
	..	PPRPWI,RPWRI	;INTEGER REVERSE ^
	..	PPEQF,.EQ.F	;FLOATING EQUAL OPERATOR
	..	PPEQI,.EQ.I	;INTEGER EQUAL OPERATOR
	..	PPEQS,.EQ.S	;STRING EQUAL OPRERATOR
	..	PPEVS,.EV.S	;STRING EQUIVALENCE
	..	PPGTF,.GT.F	;FLOATING >
	..	PPGTI,.GT.I	;INTEGER >
	..	PPGTS,.GT.S	;STRING >
	..	PPGEF,.GE.F	;FLOATING >=
	..	PPGEI,.GE.I	;INTEGER >=
	..	PPGES,.GE.S	;STRING >=
	..	PPLTF,.LT.F	;FLOATING <
	..	PPLTI,.LT.I	;INTEGER <
	..	PPLTS,.LT.S	;STRING <
	..	PPLEF,.LE.F	;FLOATING <=
	..	PPLEI,.LE.I	;INTEGER <=
	..	PPLES,.LE.S	;STRING <=
	..	PPNEF,.NE.F	;FLOATING <>
	..	PPNEI,.NE.I	;INTEGER <>
	..	PPNES,.NE.S	;STRING <>
	..	PPNEGF,NEGF	;FLOATING COMPLEMENT
	..	PPNEGI,NEGI	;INTEGER COMPLEMENT
	..	PPUSHF,PUSHF	;FLOATING PUSH
	..	PPUSHI,PUSHI	;INTEGER PUSH
	..	PPUSHS,PUSHS	;STRING PUSH
	..	PPOPF,POPF	;FLOATING POP
	..	PPOPI,POPI	;INTEGER POP
	..	PPOPS,POPS	;STRING POP
	..	PPREPF,REPLF	;REPLICATE FLOATING
	..	PPREPI,REPLI	;REPLICATE INTEGER
	..	PPREPS,REPLS	;REPLICATE STRING
	..	PPIDO1,INDO1	;INDEX OPERAND ONE SUBSCRIPT ON STACK
	..	PPIDO2,INDO2	;INDEX OPERAND TWO SUBSCRIPTS ON STACK
	..	PPIDR1,INDR1	;INDEX RESULT ONE SUBSCRIPT ON STACK
	..	PPIDR2,INDR2	;INDEX RESULT TWO SUBSCRIPTS ON STACK
	..	PPIRR1,INDL1	;INDEX, REPLICATE ONE SUBSCR.
	..	PPIRR2,INDL2	;INDEX, REPLICATE TWO SUBSCRS.
;THE FOLLOWING 12 OPS SHOULD OCCUR CONSECUTIVELY
;WITH PPFLPF FIRST AND PPFLR2 LAST
	..	PPFLPF,FPOPF	;FLOAT+POPF
	..	PPFIPI,IPOPI	;FIX+POPI
	..	PPFLRF,FREPLF	;FLOAT+REPLF
	..	PPFIRI,IREPLI	;FIX+REPLI
	..	PPFID1,IINR1	;FIX+INDR1
	..	PPFLD1,FINR1	;FLOAT+INDR1
	..	PPFIR1,IINL1	;FIX+INRR1
	..	PPFLR1,FINL1	;FLOATNRR1
	..	PPFID2,IINR2	;FIX+INDR2
	..	PPFLD2,FINR2	;FLOAT+INDR2
	..	PPFIR2,IINL2	;FIXNRR2
	..	PPFLR2,FINL2	;FLOAT+INRR2
	..	PPFIX0,PUSHI0	;PUSH AN INTEGER 0
	..	PPFIX,FIX	;FIX A FLOATING POINT NUMBER
	..	PPFLT,FLT	;FLOAT AN INTEGER
	..	PPFLT1,FLT1	;SPECIAL FLOAT
	..	PPSIN,SIN	;CALCULATE THE SINE
	..	PPCOS,COS	;CALCULATE THE COSINE
	..	PPATAN,ATAN	;CALCULATE INVERSE TANGENT
	..	PPSQRT,SQRT	;CALCULATE SQUARE ROOT
	..	PPEXP,EXP	;CALCULATE EXPONENTIAL 
	..	PPLN,LOG	;CALCULATE LOGRIRITHM
	..	PPLG10,LOG10	;CLACULATE LOGRITHM OF 10
	..	PPRND,RND	;FIND A RANDOM NUMBER
	..	PPFIXF,FIXF	;FIX FUNCTION
	..	PPTAN,TAN	;CALCULATE TANGENT
	..	PPLEN,LEN	;FIND STRING LENGTH
	..	PPSPAC,SPACES	;MAKE STRING OF SPACES
	..	PPSBST,SUBSTR	;FIND SUBSTRING
	..	PPSBS1,SUBST1	;FIND OTHER SUBSTRING
	..	PPINST,INSTR	;FIND IF IN THERE AT ALL
	..	PPNUM,NUM$	;FUNCTION NUM$
	..	PPVAL,VAL	;FUNCTION VAL
	..	PPSGNF,SGNF	;SIGN FUNCTION
	..	PPINTF,INTF	;INT FUNCTION
	..	PPABSF,ABSF	;ABS FUNCTION
	..	PPUJ,UJ		;UNCONDITIONAL JUMP
	..	PPUJX,UJX	;UNCONDITIONAL JUMP EXTERNAL
	..	PPIFJ,IFJ	;IF FALSE JUMP
	..	PPIFJX,IFJX	;IF FALSE JUMP EXTERNAL
	..	PPITJ,ITJ	;IF TRUE JUMP
	..	PPITJX,ITJX	;IF TRUE JUMP EXTERNAL
	..	PPENTR,ENTR	;ENTER FUNCTION
	..	PPEXIT,EXIT	;EXIT FROM FUNCTION
	..	PPUSHX,PUSHJX	;PUSH AND JUMP EXTERNAL
	..	PPOPJ,POPJ	;POP JUMP RETURN
	..	PPNOT,.NOT.	;LOGICAL NOT
	..	PPAND,.AND.	;LOGICAL AND
	..	PPOR,.OR.	;LOGICAL OR
	..	PPXOR,.XOR.	;LOGICAL XOR
	..	PPIMP,.IMP.	;LOGICAL IMPLIES
	..	PPIFF,.IFF.	;LOGICAL IF AND ONLY IF
	..	PPREDF,READF	;READ FLOATING
	..	PPREDI,READI	;READ INTEGER
	..	PPREDS,READS	;READ STRING
	..	PPCONC,CONCAT	;STRING CONCATENATE
	..	PPENDA,ENDRPT	;END OF CONDITIONAL OPERATOR
;	THE FOLLOWING 12 OPCODES ARE POSITION DEPENDENT
;	DO NOT CHANGE THE ORDER
	..	PPFRI,FORI	;FOR INTEGER ENTRY
	..	PPRPI,REPTI	;REPEAT INTEGER
	..	PPFRF,FORF	;FOR FLOATING
	..	PPRPF,REPTF	;REPETE FLOATING
	..	PPFRIX,FORIX	;FOR INTEGER EXTERNAL
	..	PPRPIX,REPTIX	;REPETE INTEGER EXTERNAL
	..	PPFRFX,FORFX	;FOR FLOATING EXTERNAL
	..	PPRPFX,REPTFX	;REPEAT FLOATING EXTERNAL
	..	PPNXI,NEXTI	;NEXT INTEGER
	..	PPNXF,NEXTF	;NEXT FLOATING
	..	PPNXIX,NEXTIX	;NEXT INTEGER EXTERNAL
	..	PPNXFX,NEXTFX	;NEXT FLOATING EXTERNAL
	..	PPCLOS,CLOSER	;CLOSE
	..	PPSSI,SSI	;SELECT SLOT FOR INPUT
	..	PPSSO,SSO	;SELECT SLOT FOR OUTPUT
	..	PPUSNG,USINGF	;USING ACTIVE
	..	PPINPL,INPUTL	;INPUT LINE
	..	PPINPF,INPUTF	;INPUT FLOATING
	..	PPINPI,INPUTI	;INPUT INTEGER
	..	PPINPS,INPUTS	;INPUT STRING
	..	PPRINF,PRINTF	;PRINT FLOATING
	..	PPRINI,PRINTI	;PRINT INTEGER
	..	PPRINS,PRINTS	;PRINT STRING
	..	PPCOMA,NXTZON	;PRINT COMMA THING
	..	PPCRLF,CRLF	;PRINT <CR><LF>
	..	PPSTOP,STOP	;STOP EXECUTION
	..	PPHALT,UJX6	;HALT AFTER IMMEDIATE EXECUTION
	..	PPBADC,BADCOD
	..	PPUUO,UUOCON	;UUO CONTROL
	..	PPNXTS,NEXTS	;END OF CURRENT STATEMENT GO TO NEXT ONE
	..	PPPOS,POSF	;POS FUNCTION
	..	PPTAB,TABF	;TAB FUNCTION
	..	PPCHR,CHR$	;CHR$ FUNCTION
	..	PPASC,ASCII	;ASC FUNCTION
	..	PPDAT$,DATE$	;DATE FUNCTION
	..	PPTIM$,TIME$	;TIME OF DAY FUNCTION
	..	PPTIME,TIMEF	;GENERAL TIMER FUNCTIONS
	..	PPPEEK,PEEKF	;PEEKING TOMG FUNCTION
	..	PPSLEP,SLEEP	;SLEEP FUNCTION
	..	PPWAIT,WAITF	;WAIT FUNCTION
	..	PPUSHC,PUSHC	;PUSH IMEDIATE
	..	PPRAND,RANDOM	;RANDOMIZE VERB
	..	PPREST,RESTOR	;RESTORE VERB
	..	PPRESU,RESUME	;RESUME VERB
	..	PPERR,ERR	;ERR FUNCTION(VARIABLE)
	..	PPCSV,CSV	;CHANGE STRING TO VECTOR
	..	PPCVS,CVS	;CHANGE VECTOR TO STRING
	..	PPMRD,MATRD	;MAT READ
	..	PPMIN,MATINV	;MAT INPUT
	..	PPMPRN,MATPRN	;MAT PRINT ;
	..	PPMPRT,MATPRT	;MAT PRINT
	..	PPMINP,MATINP	;MAT INPUT
	..	PPMZR,MATZRO	;MAT ZERO
	..	PPMC1,MATC1	;MAT CON
	..	PPMID,MATID	;????
	..	PPMTRN,MATTRN	;MAT TRANSPOSE
	..	PPMINV,MATINV	;MAT INVERSE
	..	PPSMPF,MATSMF	;MAT SCALAR MULTIPLY FLOATING
	..	PPSMPI,MATSMI	;MAT SCALAR MULTIPLY INTEGER
	..	PPMCPY,MATCPY	;MAT COPY
	..	PPMMUL,MATMUL	;MAT MULTIPLY
	..	PPMADD,MATADD	;MAT ADD
	..	PPMSUB,MATSUB	;MAT SUB
	..	PPOPIO,OPENIO	;OPEN FOR INPUT AND OUTPUT
	..	PPOPIN,OPENI	;OPEN FOR INPUT
	..	PPOPOU,OPENO	;OPEN FOR OUTPUT
	..	PPNAME,NAMER	;RENAME
	..	PPKILL,KILLER	;DELETE
	..	PPENDI,ENDINP	;EMPTY THE INPUT BUFFER
	..	PPCHAI,RRRRR	;CHAIN ENTRY
	..	PPLEFT,LEFT	;INITIAL SUBSTRING
	..	PPON,ONSTMT	;ON STATEMENT
	..	PPONER,ONERR	;ON ERROR GOTO
	..	PPSDRO,SETDRO	;SET THE NEXDRO FLAG FOR LOOP PPOPS
	..	PPCALL,CALLFN	;PP FOR FUNCTION CALLS
	..	PPDI,DUPLI	;DUPLICATE INTEGER
	..	PPIJS,PITJS	;POP INTEGER TO J SPACE
	..	PPJSLD,JMPSLD	;JUMP EXTERNAL, THEN NEXTS, ALL IN ONE
	..	PPEND,UJX8	;END OF PROGRAM

	.REPT	128.-OPCODE
	.WORD	ERROR	;ERROR NO CURRENT IMPLEMENTATION
	.ENDR
.=TABL2+512.		;MAKE 256 ENTRIES A'LA IBM 1800
;	MULTI-USER BASIC RUN TIME SYSTEM

.BEGIN	=	.

SWREG	=	177570
STATUS	=	177776

;	THE FOLLOWING MONITOR LOCATIONS MUST BE
;	KNOWN TO THE RUN TIME SYSTEM

;	JOBORG-THE START OF THE ABSOLUTE POINTERS TO THE JOB CORE AREA
;	JOBF  -THE LOCATION OF THE STOP FLAG

;	THE FOLLOWING EMT'S SHOULD ALSO MATCH

;	READ -READ FROM A SLOT. SLOT I/O HEADER IN R3
;	WRITE-WRITE TO A SLOT. SLOT I/O HEADER IN R3
;	BREAK-SHOW A WILLINGNESS TO PLAY THE GAME.  STOP CALL

;	THE USERS SWAP IMAGE IS COMPOSED OF FOUR MAJOR PARTS
;	1.  THE SYSTEM STACK (SP=%6)
;	2.  THE USER STACK (R1=%1)
;	3.  THE USER DATA AREA
;	4.  THE USER TEXT AREA

;	THE MULTI-USER MONITOR(BTSS.P11) MAINTAINS A CONTEXT
;	FOR EACH USER AND WHEN NOT RUNNING STORES THIS INFORMATION
;	ON THE SYSTEM STACK FOR THAT USER.
;	WHEN RUNNING THE INFORMATION IS STORED AT MONITOR
;	LOCATIONS STARTING AT JOBORG.  THE FIRST EIGHT(8) WORDS
;	ARE ALWAYS POINTING INTO THE USER SWAP IMAGE, I.E. WHEN
;	THE USER IS STOPPED THE ORGIN OF THE SWAP IMAGE IS
;	SUBTRACTED FROM EACH OF THE EIGHT WORDS AND WHEN RESTARTED
;	THE ADDRESS OF THE SWAP IMAGE IS ADDED TO EACH OF THE WORDS.

;	THE POINTERS CURRENTLY USED IN THIS AREA ARE DEFINED AS FOLLOWS
;	1.  JOBORG+00=THE START OF THE USER SWAP IMAGE
;	2.  JOBORG+02=THE END ADDRESS OF THE USER SWAP IMAGE
;	3.  JOBORG+04=UNUSED
;	4.  JOBORG+06=UNUSED
;	5.  JOBORG+10=A POINTER TO THE CURRENT TEXT HEADER
;	6.  JOBORG+12=THE START OF THE TEXT AREA
;	7.  JOBORG+14=THE START OF THE DATA AREA
;	8.  JOBORG+16=THE START OF THE SYSTEM STACK

;	THE TEXT AND DATA AREAS ARE SIMILAR IN STRUCTURE
;	IN THAT EACH HAS A BASE AREA THAT DESCRIBES THE
;	AMOUNT AND USAGE OF CORE ALLOCATED TO IT BY THE CORE ALLOCATOR.
;	THE BASE AREA HAS THE FOLLOWING FORMAT
;	LOCATION           CONTENTS
;	   00		A LINK TO THE FIRST STRING HEADER
;	   02		THE POSITIVE STATIC LIMIT
;	   04		THE NEGATIVE STATIC LIMIT
;	   06		THE POSITIVE DYNAMIC LIMIT
;	   10		THE NEGATIVE DYNAMIC LIMIT
;	   12		UNUSED
;	   14		UNUSED
;	   16		DATA STATEMENT POINTER
;	   20		RELATIVE ADDRESS OF THE CURRENT I/O HEADER
;	   22		THE CURRENT RANDOM NUMBER

;	16,20,22 ARE NOT USED IN THE TEXT AREA.
;	THE MEANS OF DYNAMIC STORAGE IS THE STRING HEADER
;	IT CONTAINS AT LEAST THREE(3) WORDS IN THE FORM
;	1.  LINK WORD
;	2.  PNTR WORD
;	3.  LENGTH WORD

;	I/O HEADERS ALSO CONTAIN
;	4.  SLOT BYTE
;	5.  FLAG BYTE
;	6.  BC WORD
;	7.  CURLOC WORD

;	ARRAY HEADERS CONTAIN
;	4.  SLOT BYTE IF DISK BASED
;	5.  TYPE BYTE
;	6.  2 WORD UPPER LIMIT ADDRESS
;	7.  2 WORD ADDITIVE OFFSET
;	8.  MULTIPLIER #1 WORD
;	9.  MULTIPLIER #2 WORD

;	TEXT HEADERS CONTAIN
;	4.  ASCII TEXT POINTER WORD
;	5.  ASCII TEXT LENGTH WORD
;	6.  STATEMENT LABEL WORD(1-9999)
;	7.  STATEMENT TYPE WORD
;	8.  CROSS LINK WORD(FOR FOR-NEXT & DEF-ENDEF)
;	BASE AREA DEFINITIONS

FORCE	=	40	;FORCE BIT FOR USER I/O BUFFER HEADER FLAGS BYTE
DSKARY	=	200	;BIT TO SHOW DISK RESIDENCE
WRTARY	=	100	;BIT TO SHOW RE-WRITE OF THE BUFFER NEEDED
WRARYW	=	40000	;WRTARY AS A WORD MASK
DIMARY	=	010	;BIT TO SHOW ARRAY DIMENSIONED
REFARY	=	004	;BIT TO SHOW ARRAY REFERENCED
STRARY	=	002	;BIT TO SHOW A ARRAY OF STRINGS
FIXARY	=	001	;BIT TO SHOW A FIXED ARRAY
FLARYW	=	1400	;FLOATING BITS AS A WORD

;	STRING -- I/O HEADER DEFINITIONS

LINK	=	0
PNTR	=	2
LENGTH	=	4
BYTCNT	=	6
CURLOC	=	10
SLOT	=	12
FLAGS	=	13
POSITN	=	14
MAXLEN	=	16

;	ARRAY HEADER DEFINITIONS

;LINK
;PNTR			AS IN STRINGS
;LENGTH
DIM1	=	6
DIM2	=	10
TYPFIL	=	12
ARYFLG	=	13
ARYSLT	=	12
ARYLIM	=	14
MULT1	=	24
MULT2	=	26
MAXSTR	=	30

;	TEXT HEADER DEFINITIONS

;LINK
;PNTR			AS IN STRINGS
;LENGTH
PTRTXT	=	6
LENTXT	=	10
LINENO	=	12
TYPTXT	=	14
CRLTXT	=	16

IOLEN	=	20	;THE LENGTH OF AN I/O BUFFER HEADER
ARYLEN	=	32	;THE LENGTH OF AN ARRAY HEADER
TXTLEN	=	20	;THE LENGTH OF A TEXT HEADER
STRLEN	=	6	;THE LENGTH OF A BASIC STRING
SHUT01:	BIT	#JFTIM-JFSTOP,@JOBF	;SEE IF QUANTUM IS UP
	BEQ	INTERP		;IF NOT GO DO MORE WORK
	MOV	#JOBORG,R4	;GET THE JOBORG LOCATION
	SUB	(R4),R1		;MAKE THE STACK AND
	SUB	(R4),R5		;  IPC RELATIVE
	.WAIT			;HI THERE NATE-HOW ARE YOU FELLA??
	ADD	(R4),R1		;GEE I WONDER IF HE MOVED ME
	ADD	(R4),R5		;BACK TO THE DUM-DRUMS
;	JMP	INTERP		;READY SET GO

;	MAIN INTERPRETER

INTERP:	TST	@JOBF		;SEE IF HE WANTS US TO QUIT
	BMI	SHUTUP		;STOP IF SO REQUESTED
	MOVB	(R5)+,R0	;GET AN OP CODE
	ASL	R0		;MAKE INTO AN INDEX
	JSR	PC,@TABL2+256.(R0)	;DISPATCH TO HANDLER
	BR	INTERP		;DO IT AGAIN-ONE MORE TIME

;	ILLEGAL OP CODE ROUTINE

ERROR:	ERRERR	!FATAL		;BAD INTERPRETIVE OPCODE

;	QUIT ROUTINE 

SHUTUP:	MOVB	@JOBF,R2	;SEE IF ^C OR JUST NO TIME LEFT
	BPL	SHUT00		;BRANCH IF QUANTUM IS UP
	BR	SHUT02		;AND STORE ALL OUR STUFF

STOP:	STPERR			;STOP-NOT REALLY AN ERROR---BUT---
SHUT02:	BIC	#JFCC,@JOBF	;CLEAR THE ^C FLAG SO RUN WORKS
	CHGPR	PR1		;RESTART THE EDITOR
	MOV	SPDA,R0		;GET A DATA POINTER
	MOV	CURRIO(R0),-(R1);STORE THE CURRENT IO POINTER
	MOV	SPTA,R4		;GET A TEXT POINTER
	MOV	SCTH,-(R1)	;STORE HEADER ADDRESS
	SUB	R4,(R1)		;MAKE RELATIVE
	SUB	R4,R5		;MAKE IPC RELATIVE
	MOV	R5,-(R1)	;SAVE THE IPC TOO
	JMP	RTSRET		;RETURN TO THE EDITOR

SHUT00:	BIC	#-JFRTS-1,R2	;CLEAR ALL BUT OUR BITS
	BIC	#JFSTOP!JFRTS,@JOBF	;CLEAR OUR BITS IN JOB FLAGS
	ADD	R2,PC		;DISPATCH
	BR	SHUT01		;NO POSTING ERRORS
	BR	POST00		;POST ERROR 0
	BR	POST01		;POST ERROR 1

POST00:	FLTERR			;FLOATING POINT ERROR
	BR	SHUT01
POST01:	FIXERR			;NUMBER TOO BIG TO BE AN INTEGER
	BR	SHUT01		;AND CONTINUE

TRPINT:	JSR	R4,SAVEM	;SAVE R4,R3,R2,R0
	MOV	10(SP),R2	;GET THE SAVED PC
	MOVB	-2(R2),R3	;GET TRAP EVEN BYTE CODE
	BEQ	TRAP06		;BRANCH IF POST ERROR
	MOV	SPDA,R2		;GET DATA AREA POINTER
	MOV	CURRIO(R2),-(SP);SAVE CURRENT IO POINTER
	MOV	14(SP),-(SP)	;SAVE THE CALL STATUS
	TST	R3		;SEE IF FATAL ERROR
	BPL	TRAP01		;BRANCH IF NON-FATAL
	BIC	#1,R1		;MAKE STACK EVEN FOR PUSH LATTER
	MOV	#EDERR,14(SP)	;STORE EDITOR RESTART ADDRESS
	MOV	#PR1,16(SP)	;START EDITOR AT LEVEL 1
	BIC	#EDCONT,@JOBORG	;CLEAR CONTINUE FLAG
	BIC	#177600,R3	;CLEAR FATAL BIT
	BNE	TRAP01		;IF NON ZERO GO NOW
	TST	(SP)+		;ELSE POP UNUSED SAVED STATUS
	BR	TRAP05		;IF ZERO ERROR THEN JUST EXIT

TRAP01:	CMPB	R3,#1		;SEE IF AN IO ERROR
	BNE	TRAP09		;BRANCH IF GARDEN VARITY USER ERROR
	ADD	@IOSTS,R3	;ADD IN IOSTS
	ASR	R3		;MAKE INTO A NUMBER NOT *2
TRAP09:	MOVB	R3,ERRVAL(R2)	;STORE THE ERROR NUMBER
	CMP	#PR2,(SP)+	;SEE IF USER RUNNING
	BLOS	TRAP07		;BRANCH IF USER ERROR
TRAP00:	BUFFER,GETSML		;GET A LITTLE BUFFER
	BVS	TRAP90		;IF ALL GONE WAIT A MINUTE
	MOV	R4,-(SP)	;SAVE R4 FOR THE EVENTUAL RETURN
	CLR	(R4)+		;CLEAR THE PLINK
	MOVB	JOB,(R4)+	;STORE THE JOB NUMBER
	MOVB	#ERRFQ,(R4)+	;STASH THE FUNCTION
	MOV	R3,(R4)+	;AND THE ERROR NUMBER
	MOV	(SP),R4		;GET THE FIRQB ADDRESS
	MOV	R3,-(SP)	;SAVE THE ERROR NUMBER
	JSR	PC,FIPCAL	;CALL MY GOOD FRIEND AND BUDDY NAT THE MONITOR MAN
	CLR	-(R1)		;SET SLOT ZERO-CONSOLE
	JSR	PC,SSO		;SELECT FOR MESSAGE
	MOV	2(SP),R2	;GET FIRQB ADDRESS BACK
	CMP	(R2)+,(R2)+	;GO TO MESSAGE PPROPER
	JSR	PC,PRINTL	;PRINT IT
	MOV	(SP)+,R0	;GET THE ERROR NUMBER BACK
	MOV	(SP)+,R4	;GET FIRQB ADDRESS BACK
	BUFFER,RETSML		;BE A GOOD BOY AND RETURN SPARE CORE
	CMP	R0,#NOLINE	;SEE IF "AT LINE----" WANTED
	BGT	TRAP04		;EXIT NOW IF NO EXTRA WORK TO DO
	MOV	#ATLINE,R2	;GET "AT LINE " STRING
	JSR	PC,PRINTL	;PRINT IT
	MOV	SCTH,R4		;GET HEADER ADDRESS
	MOV	TAGBIN(R4),-(R1);GET LINE NUMBER
	JSR	PC,PRINTI	;PRINT THE LINE NUMBER
TRAP04:	JSR	PC,CRLF		;FINISH THE LINE
TRAP05:	MOV	SPDA,R2		;GET DATA AREA PIONTER
	MOV	(SP)+,CURRIO(R2);RESTORE I/O POINTER
TRAP10:	MOV	(SP)+,R0	;RESTORE THE REGISTERS
	MOV	(SP)+,R2
	MOV	(SP)+,R3
	MOV	(SP)+,R4
	RTI			;WHITHER WANDEREST THOU WAYFARER??

BADCOD:	BADERR	!FATAL		;STATEMENT NOT EXECUTABLE

TRAP06:	BIS	(R2)+,@JOBF	;SET ERROR BITS
	MOV	R2,10(SP)	;UPDATE THE PC
	BR	TRAP10		;RESTORE REGS AND GO

TRAP90:	JSR	PC,SVACRG	;SAVE HOT REGISTERS
	.WAIT			;WAIT FOR A WHILE
	JSR	PC,RSACRG	;RESTORE THE GOODIES
	BR	TRAP00		;SEE IF ANY BUFFERS NOW

TRAP07:	MOV	OEGTLN(R2),R0	;GET ERROR LINE NUMBER
	BEQ	TRAP00		;BRANCH IF NO USER ERROR ROUTINE
	CMP	R3,#ERRCC	;SEE IF STOP
	BHIS	TRAP00		;EXIT IF STOPING
	MOV	STACK(R2),R1	;REMOVE HIS JUNK
	ADD	R1CORG,R1	;MAKE ABSOLUTE
	MOV	R2,R4		;USE R4 FOR A STRING HEADER POINTER
TRAP08:	ADD	(R4),R4		;GO SKIPPING DOWN THE CHAIN
	CMP	R4,R1		;SEE IF ON THE OLD STACK
	BLO	TRAP08		;BRANCH IF IT WAS
	SUB	R2,R4		;MAKE FIRST STRING ADDRESS RELATIVE
	MOV	R4,(R2)		;AND STORE IT AWAY
	MOV	SCTH,R5		;START OF CURRENT STATEMENT
	SUB	SPTA,R5		;MAKE RELATIVE
	MOV	R5,RESLOC(R2)	;SAVE HEADER ADDRESS
	MOV	R6CORG,SP	;RESET STACK
	MOV	#INTERP,-(SP)	;INTERPRETVER START UP OPINT
	BR	UJX1		;START HIM UP

ATLINE:	.ASCII	% AT LINE %
	.BYTE	0
;	IF (FALSE OR TRUE) JUMP ROUTINE

ITJ:	COM	(R1)		;REVERSE THE SENSE AND

IFJ:	GWTXT	R0		;GET THE POSSIBLE PLACE TO GO
	TST	(R1)+		;TEST BOOLEAN VALUE
IFJ2:	BNE	IFJ1		;IF TRUE WXIT NOW
	ADD	R0,R5		;WLSE UPDATE IPC
IFJ1:	RTS	PC		;AND RETURN

PIFJ:	MOV	SPDA,R2
	MOV	(R1),RPTERM(R2)  ;SAVE TRUTH VALUE FOR "NEXT" STATEMENT
	BR	IFJ

;	UNCONDITIONAL JUMP ROUTINE

UJ:	GWTXT	R0		;GET THE DISPLACEMENT
	ADD	R0,R5		;ADJUST THE IPC
	RTS	PC		;RETURN

;	POP AND JUMP ROUTINE

POPJ:	MOV	SPDA,R2		;GET THE ADDRESS OF THE DATA AREA
	DEC	GOSUB(R2)	;DECREMENT THE COUNTER
	BLT	POPJ99		;BRANCH IF AN ERROR
	TST	6(R1)		;THIS WORD SHOUD BE 0 IFF GOSUB DID IT
	BNE	POPJ99		;BRANCH IF AN ERROR
	MOV	SPTA,R4		;GET THE TEXT AREA POINTER
	MOV	(R1)+,R5	;GET THE RETURN ADDRESS
	ADD	R4,R5		;RELOCATE IT
	ADD	R4,(R1)		;RELOCATE THE HEADER ADDRESS TOO
	MOV	(R1)+,SCTH	;STORE THE OLD HEADER
	CMP	(R1)+,(R1)+	;POP THE TWO TYPE WORDS
	RTS	PC

POPJ99:	EXITTM	!FATAL		;NO GOSUB!!!!!!!!

;	PUSH A CONSTANT ROUTINE

PUSHC:	GWTXT	R0		;GET THE WORD OUT OF THE TEXT
	MOV	R0,-(R1)	;STORE IT ON THE STACK
	RTS	PC		;AND RETURN
;	IF TRUE JUMP EXTERNAL ROUTINE

ITJX:	COM	(R1)		;REVERSE THE SENSE

;	IF FALSE JUMP EXTERNAL ROUTINE

IFJX:	GWTXT	R0		;GET THE POINTER LOCATION
	TST	(R1)+		;SEE HOW TO GO
IFJXN2:	BNE	IFJX1		;IF TRUE FALL THRU
	BR	UJX1		;PLAY LIKE UJX NOW

;VARIANT OF IFJX USED BY "FOR" RPT LOOPS

PIFJXN:	MOV	SPDA,R2
	MOV	(R1),RPTERM(R2)  ;SAVE TRUTH VALUE FOR "NEXT" STATEMENT
	BR	IFJX

;	PUSH JUMP EXTERNAL ROUTINE

PUSHJX:	GWTXT	R0		;GET DESTINATION ADDRESS
	CLR	-(R1)		;CLEAR TWO WORDS SO WE LOOK
	INC	-(R1)		;  LIKE FUNCTION CALLS
	MOV	SPDA,R2		;GET DATA AREA POINTER
	INC	GOSUB(R2)	;INCREMENT COUNTER
PSHJX2:	SUB	SPTA,R5		;MAKE IPC RELATIVE
	MOV	SCTH,-(R1)	;SAVE THE STATEMENT HEADER ADDRESS
	SUB	SPTA,(R1)	;AND MAKE IT RELATIVE
	MOV	R5,-(R1)	;SAVE IT FOR THE POPJ
	BR	UJX1		;MAKE LIKE UJX

;	UNCONDITIONAL JUMP EXTERNAL ROUTINE

UJX:	GWTXT	R0		;GET THE POINTER LOCATION
UJX1:	MOV	SPTA,R5		;START OF TEXT POINTER AREA
	ADD	R0,R5		;RELOCATE TO POINTER
UJX2:	BIT	#EDIMED,@JOBORG	;ARE WE IN PIMMEDIATE MODE?
	BNE	UJX4		;YES--DON'T LET HIM ENTER PROGRAM
	TST	LENGTH(R5)	;CHECK FOR A NON-ZERO LENGTH
	BNE	UJX3		;GO IF NON-ZERO
	STMERR	!FATAL		;NOT FOUND ERROR

RESU3:	RESERR	!FATAL		;NO ERROR AND RESUME USED

RESUME:	GWTXT	R0		;GET THE STATEMENT HEADER
	MOV	SPDA,R2		;GET A DATA AREA POINTER
	MOV	R0,R5		;MOVE TO R5
	BNE	RESU1		;BRANCH IF START SOME PLACE ELSE
	MOV	RESLOC(R2),R5	;GET SAVED LOCATION
	BEQ	RESU3		;BRANCH IF NO ERROR AND SIMPLE RESUME
RESU1:	CLR	RESLOC(R2)	;CLEAR THE TRACKS
	ADD	SPTA,R5		;MAKE ABSOLUTE
	CHGPR	PR2		;GO TO USER LEVEL
	BR	UJX2		;AND GO LIKE UJX

UJX8:	BIC	#EDCONT,@JOBORG	;CLEAR CONTINUE
UJX6:	CHGPR	PR1		;GO TO LEVEL 1
	MOV	SPDA,R0		;RESTORE R0
	JMP	RTSRET		;RETURN TO THE EDITOR COMPILER ETC

;	NEXT STATEMENT ROUTINE

JMPSLD:	JSR	PC,UJX		;JUMP,SLIDE POP USED TO SKIP FN DEFS
NEXTS:	MOV	SCTH,R5		;GET THE ADDRESS OF THE CURRENT HEADER
NXTS01:	TST	(R5)		;SEE IF THIS IS THE END
	BEQ	UJX8		;IF SO QUIT AND RETURN TO THE EDITOR
	ADD	(R5),R5		;GO DOWN THE LINKS
NXTS02:	TST	LENGTH(R5)	;SEE IF ANY CODE TO DO
	BEQ	UJX3		;GO ON IF NULL
UJX3:	MOV	R5,SCTH		;SAVE THE HEADER ADDRESS
UJX5:	MOV	SPDA,R2		;GET DATA AREA POINTER
	MOV	R1,R3		;COPY STACK
	SUB	R1CORG,R3	;MAKE RELATIVE
	MOV	R3,STACK(R2)	;SAVE FOR ERRORS MAYBE
	MOV	LENGTH(R5),R4	;GET CODE LENGTH
	ASL	R4		;MAKE INTO GUESS AT STACK LENGTH
	MOV	R1,-(SP)	;PUSH THE CURRENT R1
	SUB	R4,(SP)		;SEE WHERE IT MIGHT GO
	CMP	(SP)+,R6CORG	;SEE IF ENOUGH ROOM
	BHIS	UJX7		;BRANCH IF NO MORE STACK NEEDED
	JSR	PC,R1SOUT	;GET MORE STACK SPACE
	MOV	SCTH,R5		;GET HEADER BACK
UJX7:	ADD	PNTR(R5),R5	;RELOCATE TO THE STRING
IFJX1:	RTS	PC		;RETURN-GOOD LUCK

UJX4:	NRNERR	!FATAL		;USE RUN--CAN'T CONTINUE

ONSTMT:	MOVB	(R5)+,R0	;GET NUMBER OF STMT HEADERS
	MOV	(R1)+,R2	;GET THE INDEX
	BLE	ONST01		;IF - OR 0 THEN FALL THRU
	CMP	R2,R0		;SEE IF TOOO BIG
	BGT	ONST01		;BRANCH IF NOT VALID
	SUB	R2,R0		;MAKE BACKWARDS FOR LIST ORDER
	ASL	R0		;MAKE A WORD INDEX
	ADD	R0,R5		;ADJUST IPC
	BR	UJX		;AND TO UJX FOR A WHILE

ONST01:	ONBAD	!FATAL		;ON STATEMENT OUT OF RANGE

;RUN IMMEDIATE MODE STATEMENT
RUNIM:	MOV	@SPTA,-(R1)	;START AT FIRST STATEMENT
	BIT	#EDPRES,@JOBORG	;VARIABLES AT LEAST RESET
	BNE	RUN50		;ALL SET
	JSR	PC,PRESET	;PRESET THAT IS TO ZERO
RUN50:	BIS	#EDPRES!EDIMED,@JOBORG	;NOTE THAT HE GOT HERE IN IMMEDIATE MODE
	BR	RTSNT1		;AND INTO THE INTERPRETER

RTSENT:	JSR	PC,RESTOR	;DO A RESTORE FOR READ STATEMENTS
	CLR	WAITTM(R2)	;CLEAR WAIT TIME
	CLR	OEGTLN(R2)	;CLEAR ON ERROR GOTO NUMBER
	CLR	GOSUB(R2)	;CLEAR GOSUB COUNT
	MOV	#15073,RNDM(R2)	;JUST A NUMBER
	BIC	#EDIMED,@JOBORG	;WE KNOW WE'RE RUNNING A PROGRAM
RTSNT1:	MOV	(R1)+,R5	;GET THE DISPLACEMENT
	ADD	SPTA,R5		;MAKE ABSOLUTE
	MOV	#INTERP,-(SP)	;START THE INTERPRETER
	CHGPR	PR2		;GO TO LEVEL 2 FOR RTS NORMAL
	BR	NXTS02		;NOW PLAY NEXTS LIKE STUFF

;CONTINUE () CALLS RTS WITHOUT FIRST CLEARING ALL OF THE USER'S VARIABLES.
DOCONT:	BIT	#EDCONT,@JOBORG	;SEE IF CONTINUING ALLOWED NOW
	BNE	RUN67		;YEP, NO CHANGES MADE TO PROGRAM
	EDCONE			;ERROR -- CANNOT CONTINUE: PROG CHANGED
RUN67:	BIC	#JFCC,@JOBF	;CLEAR ^C FOR SO WE CAN EXECUTE
	BIC	#EDIMED,@JOBORG	;TURN OFF IMEDIATE MODE CHECKING
	MOV	(R1)+,R5	;GET IPC BACK
	MOV	SPTA,R4		;AND A POINTER TO THE TEXT AREA
	ADD	R4,(R1)		;MAKE SCTH ABSOLUTE
	MOV	(R1)+,SCTH	;STORE HEADER
	MOV	(R1)+,CURRIO(R0);RESTORE CURRIO
	ADD	R4,R5		;MAKE IPC ABSOLUTE
	CHGPR	PR2		;GO TO LEVEL 2 FOR RUNNING
	JMP	INTERP		;GO BABY GO

;	LOGICAL AND ROUTINE

.AND.:	COM	(R1)		;SINCE BIC IS .NOT. AND
	BIC	(R1)+,(R1)	;COMPLEMENT SOURCE AND DO A BIC
	RTS	PC		;AND RETURN

;	LOGICAL EQUIVALENCE ROUTINE

.IFF.:	JSR	PC,.XOR.	;DO THE XOR

;	LOGICAL NOT ROUTINE

.NOT.:	COM	(R1)		;A SIMPLE COMPLEMENT WILL SOLVE THE PROBLEM
	RTS	PC		;AND RETURN

;	LOGICAL IMPLIES ROUTINE

.IMP.:	COM	2(R1)		;.IMP=A.OR.-B SO MAKE NOT B AND FALL THRU

;	LOGICAL OR ROUTINE

.OR.:	BIS	(R1)+,(R1)	;DO THE OR
	RTS	PC		;AND RETURN

.XOR.:	MOV	R1,R4		;COPY THE STACK POINTER
	MOV	(R4)+,R3	;COPY OF THE FIRST ELEMENT
	BIC	(R4),(R1)	;CLEAR COMMON BITS
	BIC	R3,(R4)		;AND THE OTHER WAY TOO
	BR	.OR.		;AND FINISH LIKE OR(NOT BOBBY)



;COMPUTE TANGENT AS SINE/COSINE
TAN:	JSR	R5,INTFUN	;STRAIGHTEN OUT ARGS
	ARG	FAF
	JSR	PC,DUPLF	;DUPLICATE ARG
	MOVFLT	(R1)+,-(SP)	;SAVE IT
	JSR	PC,SINF		;DO SIN OF ARG
	MOVFLT	(SP)+,-(R1)	;PUSH COPY OF ARG
	JSR	PC,COSF		;DO COSINE THIS TIME

DIVF:	MOV	#DIVF00,R2	;SET UP POINTER TO DIVF
ARITH:	MOV	R1,R0		;SET UP THE DESTINATION
	ADD	#6,R0		;WITH AN OFFSET TO R1
	MOV	R0,-(SP)	;SAVE R0 FOR THE NEW R1
	JSR	PC,(R2)		;GO DO THE ROUTINE
	MOV	(SP)+,R1	;RESTORE R1
	RTS	PC		;AND RETURN
;	REVERSE ARITHMETIC OPERATORS

RARITH:	MOV	R1,R0		;SET DESTINATION TO TOP OF THE STACK
	ADD	#6,R1		;SOURCE DOWN 6 BYTES
	MOV	R0,-(SP)	;SAVE R0 FOR LATER
	JSR	PC,(R2)		;GO TO IT
	MOV	(SP)+,R1	;RESTORE THE STACK POINTER
	MOV	(R1)+,4(R1)	;MOVE THE LOF
	MOV	(R1)+,4(R1)	;MOVE THE HOF
	MOV	(R1)+,4(R1)	;MOVE THE EXPONENT
	RTS	PC

RDIVF:	MOV	#DIVF00,R2	;SET UP POINTER TO DIVF
	BR	RARITH		;AND HANDLE AS RSUBF

;	FIXED POINT ARITHMETICS

NEGI:	NEG	(R1)		;NEGATE THE NUMBER
	RTS	PC		;AND RETURN

RSUBI:	NEG	2(R1)		;NEGATE NEXT TO TOP ELEMENT AND FALL THRU

ADDI:	ADD	(R1)+,(R1)	;ADD POLISH MODE
	RTS	PC		;THAT WAS QUICK WASN'T IT

SUBI:	SUB	(R1)+,(R1)	;SUBTRACT POLISH MODE
	RTS	PC		;THAT WAS QUICK ALSO

;	REPLICATE INTEGER ROUTINE

REPLI:	GWTXT	R0		;GET THE DATA AREA LOCATION
	ADD	SPDA,R0		;MAKE IT AN ABSOLUTE ADDRESS
	MOV	(R1),(R0)	;STORE WITH OUT THE POP
	RTS	PC		;AND RETURN

CMPS:	MOV	R1,R0		;COPY STACK POINTER
	MOV	R1,R3		;MAKE TWO TEMP COPYS
	ADD	#STRLEN,R3	;R3 POINTS TO SECOND STRING HEADER
	MOV	LENGTH(R0),R2	;GET # 1 LENGTH
	MOV	LENGTH(R3),R4	;GET # 2 LENGTH
	ADD	PNTR(R0),R0	;GET ADDRESS OF #1
	ADD	PNTR(R3),R3	;GET ADDRESS OF #2
CMPS0:	DEC	R2		;SEE IF ANY LEFT IN #1
	BLT	CMPS2		;FILL WITH <SP> OF NONE LEFT
	DEC	R4		;SEE IF ANY IN #2
	BLT	CMPS4		;FILL WITH <SP> IF NONE LEFT
	CMPB	(R0)+,(R3)+	;COMPARE THE TWO BYTES
	BEQ	CMPS0		;IF EQUAL CONTINUE
	BHI	CMPS1		;ELSE EXIT IF .GT.
CMPS3:	CCC			;SET .LT.
	RTS	PC		;AND RETURN

	BLT	CMPS9		;IF NONE THEN EQUAL STRINGS
	CMPB	#' ,(R3)+	;SEE IF TRAILING SPACES IN #2
	BEQ	CMPS0		;IF SO GO AGAIN
	BR	CMPS3		;ELSE SHOW .GT.

CMPS4:	CMPB	(R0)+,#' 	;SEE IF TRAILING SPACES ON #1
	BEQ	CMPS0		;IF SO GO AGAIN
CMPS1:	CCC			;.GT.
	SEN			;SET LT FLAG
	RTS	PC		;AND RETURN

CMPS2:	DEC	R4		;SEE IF ANY IN #2
	BLT	CMPS9		;IF NONE THEN EQUAL STRINGS
	CMPB	#' ,(R3)+	;SEE IF TRAILING SPACES IN #2
	BEQ	CMPS0		;IF SO GO AGAIN
	BR	CMPS3		;ELSE SHOW .GT.

CMPS9:	CMP	R2,R4		;SEE IF EQUAL LENGTH
	BNE	CMPS7		;IF SAME WITH SPACES EXIT NOW
	CLC			;SHOW IDENTICAL
	RTS	PC

CMPS7:	CCC			;CLEAR ALL CODES
	+SEZ	!SEC		;SET EQUAL AND EQUIVALENT INDICATORS
	RTS	PC

DUPLF:	MOV	4(R1),-(R1)	;COPY EXPONENT
	MOV	4(R1),-(R1)	;COPY HIGH ORDER FRACTION
	MOV	4(R1),-(R1)	;COPY LOW ORDER FRACTION
	RTS	PC		;AND RETURN

DUPLI:	MOV	(R1),-(R1)	;COPY THE WORD
	RTS	PC		;AND RETURN

DUPLS:	MOV	R1,R0		;WE'RE GOING TO INTER POSHS SO SET
	MOV	SPDA,R2		;UP R0 + R2 FOR ENTRY AT PUSH1
	BR	PUSHS1		;AND GO THERE
REPLS:	GWTXT	R0		;GET USER ADDRESS
	ADD	SPDA,R0		;COMPUTE ABSOLUTE ADDRESS
REPLS1:	MOV	LENGTH(R1),LENGTH(R0)	;COPY THE LENGTH
	MOV	PNTR(R1),R2	;GET THE RELATIVE POINTER
	ADD	R1,R2		;MAKE ABSOLUTE
	SUB	R0,R2		;ADJUST FOR NEW RESTING PLACE
	MOV	R2,PNTR(R0)	;STORE IT AWAY
	RTS	PC		;AND RETURN

PUSHS:	GWTXT	R0		;GET THE HEADER LOCATION
	MOV	SPDA,R2		;DATA AREA POINTER
PUSHS3:	ADD	R2,R0		;COMPUTE THE REAL ADDRESS
PUSHS1:	CMP	(R0)+,(R0)+	;GO TO THE LENGTH FIELD
	MOV	(R0),-(R1)	;STORE THE LENGTH FIELD
	MOV	-(R0),-(R1)	;STORE THE OLD POINTER
	ADD	R0,(R1)		;REMOVE THE OLD BIAS
	SUB	R1,(R1)		;AND ADD OUR OWN
	MOV	(R2),-(R1)	;GET THE HEAD OF THE STRING LOCATION
PUSHS2:	ADD	R2,(R1)		;REMOVE IT'S BIAS
	SUB	R1,(R1)		;AND SHOW HOW IT'S BEEN MOVED
	MOV	R1,(R2)		;STORE THE NEW START OF ALL STRINGS
	SUB	R2,(R2)		;AND MAKE IT RELATIVE
	RTS	PC

POPS:	GWTXT	R0		;GET THE STIRNG HEADER LOCATION
	MOV	SPDA,R2		;DATA AREA POINTER TO R2
	ADD	R2,R0		;POINT TO THE ABSOLUTE START OF THE HEADER
POPS1:	TST	(R0)+		;WE DON'T NEED THE LINK HERE
	ADD	R1,(R1)		;GET THE LOCATION OF THE 
	SUB	R2,(R1)		;NEXT STRING FOR THE BASE AREA POINTER
	MOV	(R1)+,(R2)	;STORE IT THERE
	ADD	R1,(R1)		;THE POINTER CHANGES BECAUSE ITS LOCATION
	SUB	R0,(R1)		;OF THE HEADER CHANGED
	BR	POPS2		;MOVE POINTER AND LENGTH
;	PUSH FLOATING POINT NUMBER ROUTINE

PUSHF:	GWTXT	R0		;GET THE ADDRESS
PUSHF3:	ADD	SPDA,R0		;COMPUTE THE REAL CORE ADDRESS
PUSHF2:	MOV	4(R0),-(R1)	;STORE THE EXPONENT
	MOV	2(R0),-(R1)	;STORE THE HIGH ORDER FRACTION
	BR	PUSHF4		;DO LOW ORDER AND EXIT

;	POP FLOATING POINT NUMBER ROUTINE

FREPLF:	MOV	(R1),-(R1)	;DUPLICATE
FPOPF:	JSR	PC,FLT		;FLOAT THEN POP TYPE DEALIE
POPF:	GWTXT	R0		;GET THE LOCATION OF THE STORE
	ADD	SPDA,R0		;COMPUTE THE REAL ADDRESS
POPF1:	MOV	(R1)+,(R0)+	;POP THE NUMBER
POPS2:	MOV	(R1)+,(R0)+
	MOV	(R1)+,(R0)+
	RTS	PC		;AND RETURN

;	PUSH INTEGER ROUTINE

PUSHI:	GWTXT	R0		;GET THE ADDRESS
	ADD	SPDA,R0		;RELOCATE IT
PUSHF4:	MOV	(R0),-(R1)	;STORE IT
	RTS	PC		;AND RETURN

;	POP INTEGER ROUTINE

IREPLI:	JSR	PC,DUPLF	;DUPLICATE
IPOPI:	JSR	PC,FIX		;FIX THE NUMBER THEN POP
POPI:	GWTXT	R0		;GET THE DATA LOCATION 
	ADD	SPDA,R0		;RELOCATE IT
	MOV	(R1)+,(R0)	;STORE THE TOP ELEMENT
	RTS	PC		;AND RETURN
INDL1:	CLR	-(R1)		;SET UP A SECOND SUBSCRIPT
INDL2:	JSR	PC,INDX90	;GO DO FUNNY THINGS COMMON TO INDX
	BISB	#WRTARY,(R0)	;SET DIDDLED BIT
	BITB	#FIXARY,(R0)	;SEE IF FLOATING
	BNE	INDX50		;BRANCH IF TRUE
	BITB	#STRARY,(R0)	;SEE IF STRING HEADER
	BNE	INDX60		;BRANCH IF STRING
	MOV	(R1),(R3)+
	MOV	2(R1),(R3)+	;STORE FLOATING - NO POP
	MOV	4(R1),(R3)+
	RTS	PC		;AND RETURN

INDX50:	MOV	(R1),(R3)	;REPLICATE INTEGER
INDX55:	RTS	PC		;AND RETURN

INDX60:	TSTB	(R0)		;SEE IF DSK AND STRING
	BMI	INDX62		;BRANCH IF THE WORST CASE
	MOV	R3,R0		;MOVE POINTER TO R0
	BR	REPLS1		;AND GO TO REPLS

INDX62:	MOV	#INDX55,-(SP)	;ADDRESS OF AN RTS  PC
	BR	INDX42		;AND MAKE LIKE POP

INDO1:	CLR	-(R1)		;MAKE A PHONY #2 SUBSCRIPT
INDO2:	JSR	PC,INDX90	;CALCULATE INDEX INTO ARRAY
INDO3:	BITB	#FIXARY,(R0)	;SEE IF FIXED-FLOAT-STRING
	BNE	INDX10		;BRANCH IF PUSH FLOATING
	BITB	#STRARY,(R0)	;SEE IF FIXED-STRING
	BNE	INDX20		;BRANCH IF PUSH STRING
	MOV	4(R3),-(R1)
	MOV	2(R3),-(R1)	;FLOATING POINT PUSH
INDX10:	MOV	(R3),-(R1)
	RTS	PC		;AND RETURN

INDX20:	TSTB	(R0)		;SEE IF DISK BASED
	BMI	INDX21		;BRANCH IF FUNNY STRING ON DISK
	MOV	R3,R0		;COPY STRING HEADER ADDRESS
	MOV	SPDA,R2		;SET UP FOR ENTRY TO PUSHS
	BR	PUSHS1		;AND ENTER IN THE MIDDLE

INDX40:	TSTB	(R0)		;SEE IF STRING IS ON DISK STORAGE
	BMI	INDX41		;BRANCH TO PICK UP THE MESSY ONE(DSK&STRING)
	MOV	R3,R0		;COPY HEADER ADDR TO R0
	MOV	SPDA,R2		;SET UP PDA POINTER
	BR	POPS1		;AND JOIN FORCES WITH POPS

INDX21:	SUB	R2,R3		;MAKE ADDRESS OF STRING REALTIVE
	MOV	R3,-(R1)	;SAVE ON R1 STACK
	MOV	R4,R3		;SET UP MAXIMUM LENGTH NEEDED
	JSR	PC,BUILDS	;SET UP TO BUILD A STRING
	MOV	(R1)+,R2	;GET RELATIVE STRING ADDRESS BACK
	ADD	R0,R2		;MAKE ABSOLUTE AGAIN
INDX22:	MOVB	(R2)+,(R3)+	;MOVE A CHARACTER
	SOB	R4,INDX22	;LOOP IF STILL MORE
INDX23:	TSTB	-(R3)		;SE IF UNNEEDED NULL
	BEQ	INDX23		;LOOP IF JUNK
	INC	R3		;ELSE COUNT IT
	JSR	PC,@(SP)+	;AND RETURN TO BUILDS
	MOV	(SP)+,R5	;RESTROE IPC
	MOV	(R2),(R1)	;SET LINK TO FIRST STRING
	JMP	PUSHS2		;AND INSERT STRING IN LIST

INDR1:	CLR	-(R1)		;MAKE SECOND ENTRY + USE INDR2
INDR2:	JSR	PC,INDX90	;CALC ALL KINDS OF STUFF
INDR3:	BISB	#WRTARY,(R0)	;MAKE SURE TO WRITE IT BACK OUT
	BITB	#FIXARY,(R0)	;SEE IF FLOATING
	BNE	INDX30		;BRANCH IF SO
	BITB	#STRARY,(R0)	;SEE IF A STRING
	BNE	INDX40		;BRANCH IF SO
	MOV	(R1)+,(R3)+
	MOV	(R1)+,(R3)+	;STORE FLOATING POINT
INDX30:	MOV	(R1)+,(R3)+
INDX46:	RTS	PC		;AND RETURN

INDX41:	MOV	#PSTJS,-(SP)	;WHEN DONE POP A STRING
INDX42:	MOV	LENGTH(R1),R2	;GET LENGTH OF THE STRING
	CMP	R2,R4		;SEE HOW COMPARED WITH MAX ALLOWED
	BLE	INDX43		;BRANCH IF OK
	MOV	R4,R2		;ELSE TRUNCATE TO MAX LENGTH
INDX43:	MOV	R1,R0		;COPY STACK SO AS TO NOT DESTROY POINTER
	ADD	PNTR(R1),R0	;GET A POINTER TO THE STRING PROPER
INDX44:	MOVB	(R0)+,(R3)+	;STORE A CHARACTER
	DEC	R4		;DECREMENT FOR NULL INSERTION
	SOB	R2,INDX44	;LOOP IF MORE TO DO
INDX45:	DEC	R4		;SEE IF NULLS NEEDED
	BLT	INDX46		;BRANCH IF DONE
	CLRB	(R3)+		;ADD A NULL
	BR	INDX45		;LOOP FOR MORE IF NEEDED

IINR1:	CLR	-(R1)		;MAKE SECOND SUBSCRIPT 0
IINR2:	MOV	(R1)+,-(SP)	;SAVE #2
	MOV	(R1)+,-(SP)	;SAVE #1
IINR3:	JSR	PC,FIX		;MAKE VALUE AN INTEGER
	MOV	(SP)+,-(R1)	;RESTORE #1
	MOV	(SP)+,-(R1)	;RESTORE #2
	BR	INDR2		;MAKE LIKE A WELL KNOWN OTHER OP

IINL1:	CLR	-(R1)		;MAKE SECOND SUBSCRIPT 0
IINL2:	MOV	(R1)+,-(SP)	;SAVE THE SECOND SUBSCRIPT
	MOV	(R1)+,-(SP)	;AND #1 TOO
	JSR	PC,DUPLF	;DUPLICATE FLOATING
	BR	IINR3		;AND GO TO ABOVE

FINR1:	CLR	-(R1)		;SAME GAME #2=0
FINR2:	MOV	(R1)+,-(SP)	;SAVE #2
	MOV	(R1)+,-(SP)	;SAVE #1
FINR3:	JSR	PC,FLT		;MAKE INTO FLOATING
	MOV	(SP)+,-(R1)	;RESTORE #1
	MOV	(SP)+,-(R1)	;RESTORE #2
	BR	INDR2		;DO A ANOTHER OPERATION

FINL1:	CLR	-(R1)		;WE KNOW WHAT HE WANTS
FINL2:	MOV	(R1)+,-(SP)	;SAVE #2
	MOV	(R1)+,-(SP)	;SAVE #1
	MOV	(R1),-(R1)	;DUPLICATE IT
	BR	FINR3		;AND RESUME ABOVE

INDX90:	GWTXT	R0		;GET THE DOPE VECTOR ADDRESS
	MOV	R0,R2		;COPY POINTER FOR POSSIBLE ALLOCATION
	ADD	SPDA,R0		;AND MAKE ABSOLUTE
	TST	LENGTH(R0)	;SEE IF ANY ARRAY
	BNE	INDX88		;BRANCH IF ALL THERE
	TSTB	ARYFLG(R0)	;SEE IF DSK OR  CORE
	BPL	INDX83		;BRANCH IF CORE VARIETY
	MOVB	ARYSLT(R0),R4	;GET THE SLOT NUMBER
	ASL	R4		;BY 4
	ASL	R4		;BY 8
	ASL	R4		;NOW TO A BYTE INDEX
	ADD	#BASE+IOLEN,R4	;R4 IS NOW RELATIVE BUFFER ADDRESS
	ADD	SPDA,R4		;MAKE IT ABSOLUTE
	MOV	R4,-(SP)	;SAVE HEADER ADDRESS
	TST	LENGTH(R4)	;SEE IF ITS OPEN OR NOT
	BEQ	INDX70		;BRANCH IF NOT OPEN
	MOV	PNTR(R4),R3	;PICK UP THE POINTER TO THE BUFFER
	ADD	R4,R3		;MAKE IT ABSOLUTE
	SUB	R0,R3		;MAKE IT RELATIVE TO DOPE VECTOR
	MOV	R3,PNTR(R0)	;STORE IT AWAY HERE
	BR	INDX88		;SKIP CORE STUFF

INDX70:	VCOERR	!FATAL		;VIRTUAL ARRAY NOT OPEN

INDX61:	ADD	#MULT2+2,R0	;GO TO THE END OF THE PARAMETERS
	BITB	ARYFLG-MULT2-2(R0),#FIXARY	;SEE IF INTEGER
	BEQ	INDX63		;BRANCH IF FLOATING OR STRING
	TST	(R0)		;SEE IF ONE OR TWO SUBSCRIPTS
	BEQ	INDX67		;BRANCH IF ONE SUB INTEGER
	MOV	#1.,-(R0)	;MULT 2
	MOV	#11.,-(R0)	;MULT 1
	MOV	#121.,R4		;LINIT
	BR	INDX65		;AND REJOIN STREAM

INDX67:	CLR	-(R0)		;MULT2
	MOV	#1.,-(R0)	;MULT1
	MOV	#11.,R4		;LIMIT
	BR	INDX65	;AND RE JOIN THE REST

INDX63:	TST	(R0)		;SEE IF TWO SUBS
	BEQ	INDX64		;BRANCH IF ONE SUB FLOAT OR STRING
	MOV	#3.,-(R0)	;MULT2
	MOV	#33.,-(R0)	;MULT1
	MOV	#363.,R4	;LIMIT
	BR	INDX65		;GO LIKE THE OTHERS

INDX64:	CLR	-(R0)		;MULT2
	MOV	#3.,-(R0)	;MULT1
	MOV	#33.,R4		;LIMIT
INDX65:	CLR	-(R0)		;OFFSET 1
	CLR	-(R0)		;OFFSET 2
	CLR	-(R0)		;LIMIT 1
	MOV	R4,-(R0)	;LIMIT 2
	SUB	#MULT2-12,R0	;BACK TO THE ARRAY HEADER
	BR	INDX66		;AND BACK PTHE REST OF THE FOOT WORK


INDX83:	BITB	#DIMARY,ARYFLG(R0)	;SEE IF DIMENSIONED YET
	BEQ	INDX61		;BRANCH IF STANDARD SIZE
INDX66:	MOV	ARYLIM(R0),R0	;GET THE NEEDED LENGTH
	ASL	R0		;MAKE INTO BYTE LENGTH
	JSR	PC,THENT	;GO ALLOCATE BUFFER SPACE
	ADD	R4,R2		;COMPUTE ABS POINTER TO HEADER
	MOV	R2,-(SP)	;AND SAVE IT FOR A MINUTE
	ASR	R0		;COMPUTE BACK TO WORDS
	BEQ	INDX72		;SKIP IF NO ARRAY
	ADD	PNTR(R2),R2	;GO TO THE AREA PROPER
INDX71:	CLR	(R2)+		;CLEAN UP A WORD
	SOB	R0,INDX71	;LOOP TIL DONE
INDX72:	MOV	(SP)+,R0	;RESTORE HEADER ADDRESS
	BITB	#DSKARY!STRARY,ARYFLG(R0)	;SEE IF STRING HEADERS NEEDED
	BLE	INDX88		;THINK ABOUT THIS ONE
	MOV	R0,R2		;COPY THE HEADER ADDRESS
	MOV	LENGTH(R0),R3	;GET THE LENGTH
	ADD	PNTR(R0),R2	;AND POINT TO THE AREA
	MOV	R2,-(SP)	;SAVE START ADDRESS
INDX73:	MOV	#6,(R2)		;STORE A LINK
	SUB	(R2),R3		;DECREMENT THE LENGTH
	BLE	INDX74		;BRANCH IF DONE
	ADD	(R2),R2		;SKIP DOWN THE CHAIN????
	BR	INDX73		;AND LOOP FOR MORE

INDX76:	CLR	R2		;FOR FAST MULT BY 0
	BR	INDX77		;AND RESUME
INDX97:	VCAERR	!FATAL		;DISK ARRAY NOT ON DISK

INDX99:	SIZERR	!FATAL		;DISK ARRAY TOO BIG.

INDX74:	MOV	R4,R3		;COPY SPDA
	ADD	#DUMSTR,R3	;DUMSTR GETS IT A LOT HERE
	MOV	(R3),(R2)	;COPY OLD LINK
	BEQ	INDX75		;BRANCH IF END OF THE LINE
	ADD	R3,(R2)		;MAKE ABSOLUTE
	SUB	R2,(R2)		;NOW RELATIVE TO HERE
INDX75:	MOV	(SP)+,R2	;GET THE HEAD OF THE LIST
	MOV	R2,(R3)		;STORE IT AT DUMSTR
	SUB	R3,(R3)		;AND MAKE RELATIVE
INDX88:	ADD	#MULT2+2,R0	;POINT TO MULTIPLIER #2+2
	MOV	-(R0),R2	;GET MULTIPLER '2
	MOV	(R1)+,R3	;AND INDEX #2
	BEQ	INDX76		;BRANCH IF ONLY ONE MULT NEEDED
	JSR	PC,MULTI	;THEN MULTIPLY PART #2
INDX77:	MOV	R2,-(SP)	;SAVE THE TERM
	MOV	R3,-(SP)	;FOR A LITTLE LATER
	MOV	-(R0),R2	;GET MULTIPLIER #1
	MOV	(R1)+,R3	;AND INDEX #1
	JSR	PC,MULTI	;MULTIPLY PART #1
	ADD	(SP)+,R3	;ADD IN LOW ORDER PART #2
	ADC	R2		;PROPAGATE THE CARRY
	ADD	(SP)+,R2	;AND FINISH UP WITH THE RIG LOADER
	ADD	-(R0),R3	;ADD OFFSET FOR VIRTUAL CORE
	ADC	R2		;ARRAY 0 IF REAL CORE ARRAY
	ADD	-(R0),R2	;AND FINISH THE HIGH ORDER
	CMP	R2,-(R0)	;SEE HOW THE HIGH ORDER PARTS ARE
	BLT	INDX85		;BRANCH IF OK
	BGT	INDX96		;BRANCH IF SUBSCRIPTING ERROR
	TST	-(R0)		;GO TO LOW ORDER WORD
	CMP	R3,(R0)+	;SEE ABOUT THE LOW ORDERS
	BHIS	INDX96		;BRANCH IF AN ERROR
INDX85:	TST	-(R0)		;POP OVER THE LOW ORDER
MATTW1:	MOV	-(R0),R4	;TEST TYPE - CORE VS DSK
	BPL	INDX94		;BRANCH IF CORE ADDRESS ALREADY
	CLR	-(SP)		;MAKE SURE HIGH BYTE IS 0
	MOVB	R3,(SP)		;SAVE WORD WITH IN BLOCK ADDRESS
	CLRB	R3		;CLEAR THAT PART
	SWAB	R3		;SHIFT RIGHT 8 BITS
	SWAB	R2		;ORDER STARTED R2-R3 AS ABCD
	TSTB	R2		;WE WANT 0ABC BUT A MUST BE 0
	BNE	INDX99		;BRANCH IF TOO BIG FOR FIP TO HANDLE
	BIS	R3,R2		;MAKE FINAL RESULT 00BC-BLOCK IN R2
	BIT	R4,#FLARYW	;SEE IF FLOATING POINT
	BNE	INDX91		;BRANCH IF NOT FLOATING
	INC	(SP)		;SKIP THE FIRST WORD OF A BLOCK
	ADD	R2,(SP)		;THE WORD ADDRESS IS JUSTIFIED
	MOVB	1(SP),R3	;BY THE BLOCK # AND THEN
	ADD	R3,R2		;THE OVERFLOW ADDED BACK TO THE BLK #
	CLRB	1(SP)		;ZOT ANY OVERFLOW
	BCS	INDX99		;IF OVERFLOW QUIT
INDX91:	MOVB	R4,R4		;GET SLOT INDEX FOR FCB POINTER
	MOV	2(SP),R3	;GET IO HEADER ADDRESS
	ADD	@JOBDA,R4	;CALCULATE THE FCB ADDRESS
	MOV	(R4),R4		;GET FCB ADDRESS
	MOV	R2,-(SP)	;SAVE THE BLOCK #
	MOV	LENGTH(R3),BYTCNT(R3)	;SET UP FOR WRITE AND/OR READ
	MOV	PNTR(R3),CURLOC(R3)	;BOTH BYTE COUNT AND ADDRESS
	TSTB	(R4)		;SEE IF DSK FCB
	BNE	INDX97		;BRANCH IF NOT DISK
	MOV	#JOBORG,R2	;GET DATA AREA ORIGIN POINTER
	MOV	(R0),-(SP)
	SUB	(R2),R0
	SUB	(R2),R1		;MAKE THE REGISTERS RELATIVE
	SUB	(R2),R3		;RELATIVISE BLOCK HEADER FOR MONITOR
	SUB	(R2),R5
INDX87:	CMP	2(SP),FCSIZ(R4)	;SEE IF THE BLOCK EXISTS YET
	BHIS	INDX98		;BRANCH TO CREATE IT
	CMP	2(SP),FCNLB(R4)	;SEE IF IT'S ALREADY IN
	BEQ	INDX89		;BRANCH IF QUICK
	BR	INDX80		;ELSE READ IT IN

INDX98:	MOV	R4,-(SP)	;SAVE FCB ADDRESS
	MOV	4(SP),-(SP)	;COPY THE BLOCK NUMBER NEEDED
	SUB	FCSIZ(R4),(SP)	;COMPUTE NUMBER NEEDED
	INC	(SP)		;HIGHEST BLOCK OF N BLOCK FILE IS N-1
INDX82:	BUFFER,GETSML		;GET A BUFFER FOR A FIRQB
	BVS	INDX81		;BRANCH IF A WAIT IS NEEDED
	MOV	R4,R3		;COPY THE POINTER
	CLR	(R3)+		;SKIP THE LINK
	MOVB	JOB,(R3)+	;INSERT THE JOB
	CLRB	(R3)+		;EXTFQ = 0
	MOV	12(SP),R3	;GET THE BUFFER HEADER
	MOVB	SLOT(R3),FQFIL(R4)	;ENTER THE SLOT NUMBER
	SUB	(R2),R3		;MAKE IT RELATIVE
	MOVB	(SP)+,FQSIZ(R4)	;ENTER THE SIZE WANTED
	CALFIP			;CALL FOR FILE PROCESSING
	BUFFER,	RETSML		;GIVE BACK THE FIRQB
	MOV	(SP)+,R4	;RESTORE FCB ADDRESS
	TST	@IOSTS		;SEE IF ANY ERROR
	BEQ	INDX87		;LOOP TO SEE IF WE'RE THERE
INDX86:	ADD	(R2),R1		;ABSOLUTE IZE R1
	ADD	(R2),R5		;AND R5 TOO
	IOTERR	!FATAL		;SIGNAL THE END OF THE WORLD
INDX80:	BIT	#WRARYW,(SP)+	;SEE IF WE NEED TO WRITE
	BEQ	INDX92		;BRANCH IF NO WRITE
	.WRITE			;UPDATE THE DISK
	TST	@IOSTS		;SEE IF IO ERROR
	BNE	INDX86		;BRANHC IF AN ERROR
INDX92:	MOV	(SP)+,FCNLB(R4)	;CHANGE BLOCKS
	.READ			;READ IN THE NEW BLOCK
	TST	@IOSTS		;TEST IO ERROR FLAG
	BNE	INDX86		;BRANCH IF AN ERROR
	ADD	(R2),R0
	ADD	(R2),R1	;MAKE REGISTER ABSOLUTE AGAIN
	ADD	(R2),R5
	DEC	FCNLB(R4)	;BACK UP FOR POSSIBLE RE-WRITE
	BIC	#WRARYW,(R0)	;CLEAR THE USED BIT
INDX93:	CLR	R3		;CLEAR WORD ADDRESS
	BISB	(SP)+,R3	;GET DISPLACEMENT IN BUFFER
	TST	(SP)+		;REMOVE IO HEADER ADDRESS
INDX94:	ASL	R3		;MAKE INTO BYTE ADDRESS
	BVS	INDX96		;IF OVERFLOW BETTER TELL HIM
	BMI	INDX96		;IF WRONG DIRECTION TOO
INDX95:	ADD	R0,R3		;GO TO ABSOLUTE ADDRESS
	SUB	#TYPFIL,R3	;SUB TYPFIL BECAUSE R0 IS OFF BY TYPFIL
	ADD	PNTR-TYPFIL(R0),R3	;AND MOVE TO THE BUFFER ITSELF.
	MOV	MAXSTR-TYPFIL(R0),R4	;GET MAX STRING LENGTH
	ASL	R4		;MAKE INTO A BYTE COUNT
	MOV	SPDA,R2		;AND A PUBLIC SERVICE GESTURE
	INC	R0		;POINT TO THE FLAG BYTE
	RTS	PC

INDX96:	SUB	SPDA,R0		;MAKE R0 RELATIVE
	SUBERR			;SUBSCRIPING ERROR
	ADD	SPDA,R0		;MAKE ABSOLUTE AGIAN
	CLR	R3		;MAKE INDEX 0
	BR	INDX95

INDX81:	.WAIT			;THIS IS THE EASY PART
	BR	INDX82		;AND RESUME

INDX89:	CMP	(SP)+,(SP)+	;POP JUNK FROM STACK
	ADD	(R2),R0		;ABSOLUTE R0
	ADD	(R2),R1		;YUP
	ADD	(R2),R5		;SUBROUTINE SOMEDAY...
	BR	INDX93		;DONE
ARST00:	MOV	#1,R3		;FIXED LENGTH
	BR	ARST04		;REJOIN THE GROUP
ARYSET:	JSR	R5,SAVREG	;SAVE THE REGISTERS
	MOV	10(R1),R5	;GET THE HEADER ADDRESS
	ADD	R0,R5		;MAKE THE ADDRESS ABSOLUTE
	MOV	#512.,R3	;GET MAX POSSIBLE
	MOV	(R1)+,R2	;GET MAX LENGTH
	BEQ	ARST06		;BRANCH IF NOT SPECIFIED
ARST01:	ASR	R3		;SHIFT OR DIVIDE BY 2
	CMP	R2,R3		;SEE IF LITTLE ENOUGH
	BLE	ARST01		;LOOP IF TOO BIG
	ASL	R3		;COMPUTE # PER BLOCK
	BNE	ARST02		;SEE IF ANY SPECIFIED
ARST06:	MOV	#8.,R3		;DEFAULT TO 16 IN LENGTH
ARST02:	MOV	R3,MAXSTR(R5)	;STORE STRING LENGTH FOR VIRTUAL CORE
	MOVB	4(R1),R2	;GET FLAGS BYTE
	BISB	R2,ARYFLG(R5)	;STORE IT AWAY
	ASL	R2		;MAKE INTO A BRANCH INDEX
	ADD	R2,PC		;DISPATCH ON TYPE
	BR	ARST03		;BRANCH FOR FLOATING
	BR	ARST00		;BRANCH FOR FIXED
	TST	10(R1)		;SEE IF CORE OR DSK
	BNE	ARST04		;BRANCH IF DISK BASED
ARST03:	MOV	#3,R3		;SET LENGTH
ARST04:	MOV	R3,MULT1(R5)	;STORE THE FIRST MULTIPLIER
	MOV	2(R1),R2	;GET DIMENSION 1
	INC	R2		;ADJUST FOR 0--N SUBSCRIPTS
	JSR	PC,MULTI	;CALCULATE MULT2
	MOV	R3,MULT2(R5)	;STORE IT
	MOV	(R1)+,R2	;GET DIMENSION 2
	BNE	ARST07		;BRANCH IF SECOND ONE
	CLR	MULT2(R5)	;CLEAR SECOND MULTIPLIER
ARST07:	INC	R2		;ADJUST AS ABOVE
	JSR	PC,MULTI	;CALCULATE LIMIT DISPLACEMENT
	ADD	#14,R1		;POP ALL OF IT
	MOV	-(R1),R0	;GET LOW ORDER OFFSET
	MOV	-(R1),R4	;GET HIGH ORDER OFFSET
	ADD	R0,R3		;ADD OFFSET
	ADC	R2		;  TO THE CURRENT
	ADD	R4,R2		;    LIMIT TO GET NEW ODFFSET
	ADD	#MULT1,R5	;GO TO THE END OF THE HEADER
	MOV	R0,-(R5)	;STORE LOW ORDER OFFSET
	MOV	R4,-(R5)	;STORE HIGH ORDER OFFSET
	MOV	R2,-(R5)	;STORE HIGH ORDER LIMIT
	MOV	R3,-(R5)	;STORE LOW ORDER LIMIT
	MOV	-(R1),R4	;GET SLOT NUMBER IF ANY
	BEQ	ARST05		;BRANCH IF CORE TYPE
	BISB	#200,-(R5)	;SET DSK TYPE
	ASL	R4		;DOUBLE THE SLOT NUMBER
	MOVB	R4,-(R5)	;STORE SLOT NUMBER
	MOV	R3,4(R1)	;STORE NEW OFFSET LOW PART
	MOV	R2,2(R1)	;STORE HIGH PART
ARST05:	MOV	R1,2(SP)	;RETURN OUR R1 TO SAINT
	JSR	R5,RESREG	;RESTORE THE REGISTERS
	RTS	PC		;AND RETURN
;INTEGER RELATIONALS
.GT.I:	CMP	(R1)+,(R1)	;COMPARE THE NUMBERS
	BLT	TRU.		;BRANCH IF TRUE
	BR	FLS.		;ELSE SET FALSE

.GE.I:	CMP	(R1)+,(R1)
	BLE	TRU.
	BR	FLS.

.LT.I:	CMP	(R1)+,(R1)
	BGT	TRU.
	BR	FLS.		;ALL 6 ROUTINES ARE

.LE.I:	CMP	(R1)+,(R1)	;STRIKINGLY SIMILAR - HUH?
	BGE	TRU.
	BR	FLS.

.NE.I:	CMP	(R1)+,(R1)
	BNE	TRU.
	BR	FLS.

.EQ.I:	CMP	(R1)+,(R1)
	BEQ	TRU.
FLS.:	CLR	(R1)		;SHOW FALSE RESULT
	RTS	PC		;AND RETURN

TRU.:	MOV	#-1,(R1)	;SHOW TRUE ANSWER
	RTS	PC		;AND RETURN
;	FLOATING RELATIONAL OPERATORS

.GT.F:	JSR	PC,CMPF		;COMPARE THE NUMBERS
	BGT	.TRUE		;BRANCH IF CONDITION HELD
	BR	.FALSE		;ELSE MAKE FALSE

.GE.F:	JSR	PC,CMPF		;COMPARE THE NUMBERS
	BGE	.TRUE		;BRANCH IF TRUE
	BR	.FALSE		;ELSE IS NO GOOD

.LT.F:	JSR	PC,CMPF		;COMPARE THE NUMBERS
	BLT	.TRUE		;BRANCH TO STORE TRUE
	BR	.FALSE		;ELSE IS FALSE

.LE.F:	JSR	PC,CMPF		;COMPARE THE NUMBERS
	BLE	.TRUE		;BRANCH IF TRUE
	BR	.FALSE		;ELSE IS FALSE NO?

.EQ.F:	JSR	PC,CMPF		;COMPARE THE NUMBERS
	BEQ	.TRUE		;STORE TRUE ON EQUAL
	BR	.FALSE		;ELSE FALSE

.NE.F:	JSR	PC,CMPF		;COMPARE THE NUMBERS
	BNE	.TRUE		;BRANCH IF TRUE

.FALSE:	CLR	R2		;SET FALSE INDICATION
	BR	.TRUE1		;FINISH UP VIA TRUE

.TRUE:	MOV	#-1,R2		;SET TRUE INDICATION
.TRUE1:	CMP	(R1)+,(R1)+	;GET RID OF A LITTLE JUNK
	MOV	R2,(R1)		;AND REPLACE THE THIRD
	RTS	PC		;AND RETURN

.EV.F:	MOV	(R1)+,-(SP)	;SAVE THE FIRST 
	MOV	(R1)+,-(SP)	;  NUMBER ON THE SYSTEM
	MOV	(R1)+,-(SP)	;    STACK FOR LATER
	JSR	PC,NUM$		;MAKE INTO A STRING
	MOV	(SP)+,-(R1)	;NOW GET THAT NUMBER BACK
	MOV	(SP)+,-(R1)	;  ON THE STACK SO
	MOV	(SP)+,-(R1)	;    WE CAN CONTINUE
	JSR	PC,NUM$		;MAKE IT INTO A STRING ALSO
	BR	.EQ.S		;NOW IT BECOMES A STRING COMPARE

;	STRING COMPARE AND STRING RELATIONALS ROUTINES

.GT.S:	JSR	PC,CMPS		;COMPARE THE STRINGS
	BGT	.TRU		;BRANCH IF TRUE CONDITION
	BR	.FLS

.GE.S:	JSR	PC,CMPS		;COMPARE THE STRINGS
	BGE	.TRU		;BRANCH PIFTRUE
	BR	.FLS		;ELSE SHOW FALSE

.LE.S:	JSR	PC,CMPS		;COMPARE THE STRINGS
	BLE	.TRU		;BRANCH IF TRUE
	BR	.FLS		;ELSE IS FALSE NO?

.LT.S:	JSR	PC,CMPS		;COMPARE THE STINGS
	BLT	.TRU		;BRANCH IF TRUE
	BR	.FLS		;ELSE NOT TRUE

.EQ.S:	JSR	PC,CMPS		;COMAPRE THE STRINGS
	BEQ	.TRU		;BRANCH IF TRUE
	BR	.FLS		;ELSE MAKE FALSE

.NE.S:	JSR	PC,CMPS		;DO THE COMPARE
	BNE	.TRU		;BRANCH IF NOT THE SAME
	BR	.FLS		;BRANCH IF SAME

.EV.S:	JSR	PC,CMPS		;SEE HOW THEY COMPARE
	BNE	.FLS		;NOT EQUAL
	BCC	.FLS		;AND NOT EQUIVALENT

.TRU:	MOV	#-1,R2		;SHOW TRUE CONDITION
	BR	.FLS1		;AND CONTINUE

.FLS:	CLR	R2		;SHOW FALSE CONDITION
.FLS1:	MOV	R1,R0		;COPY THE STACK POINTER
	ADD	(R0),R0		;SKIP DOWN ONE
	ADD	(R0),R0		;DOWN TWO STRINGS
	SUB	SPDA,R0		;MAKE RELATIVE AGAIN
	MOV	R0,@SPDA	;AND STORE IT AWAY
	ADD	#14,R1		;REMOVE THE STRING POINTERS
	MOV	R2,-(R1)	;STORE THE VALUE
	RTS	PC

RESTOR:	MOV	SPDA,R2		;GET A DATA AREA POINTER
	MOV	@SPTA,DATHDR(R2);STORE FIRST POSSIBLE DATA STATEMENT
	CLR	DATCNT(R2)	;CLEAR BYTES LEFT
	RTS	PC		;AND RETURN

READI:	JSR	R4,READER	;CALL COMMON READ PROCESSOR
	+	INPUTI		;JUST LIKE INPUT--HUH

READF:	JSR	R4,READER	;CALL READ ROUTINE
	+	INPUTF		;DO LIKE INPUTF

READS:	JSR	R4,READER	;CALL READ ROUTINE
	+	INPUTS		;PROCESSING ROUTINE ADDRESS

READ09:	ODD	!FATAL		;OUT OF DATA

READER:	MOV	SPDA,R2		;GET A DATA AREA POINTER
	MOV	#BASE,CURRIO(R2);SET UP SOME KIND OF FUNNY IO!
READO1:	MOV	R2,R3		;COPY SPDA
	ADD	#BASE+CURLOC,R3	;WE'LL USE R3 A LOT
	MOV	DATPTR(R2),(R3)	;STORE CURRENT LOCATION
	ADD	SPTA,(R3)	;MAKE ABSOLUTE
	SUB	R3,(R3)		;MAKE RELATIVE TO CURLOC
	ADD	#CURLOC,(R3)	;NOW TO THE HEADER ITSELF
	MOV	DATCNT(R2),-(R3);NOW MOVE THE COUNTER
	BEQ	READ05		;BRANCH IF NEXT DATA STATEMENT NEEDED
	JSR	PC,@(R4)+	;GO PROCESS AS INPUT
	MOV	BYTCNT(R4),DATCNT-BASE(R4)	;STORE REMAINING COUNT
	MOV	CURLOC(R4),(SP)	;PUT THE POINTER ON OLD R4
	ADD	R4,(SP)		;MAKE ABSOLUTE
	SUB	SPTA,(SP)	;AND NOEW RELATIVE TO THE TEXT
	MOV	(SP)+,DATPTR-BASE(R4)	;STORE THE NEW POINTER
ENDI01:	CLR	BYTCNT(R4)	;EMPTY THE BUFFER FOR NOW
	RTS	PC		;AND RETURN

READ05:	MOV	DATHDR(R2),R0	;GET RELATIVE HEADER ADDRESS
	ADD	SPTA,R0		;MAKE ABSOLUTE
READ06:	TST	(R0)		;SEE IF THE END OF THE ROAD
	BEQ	READ09		;BRANCH IF OUT OF DATA
	ADD	(R0),R0		;SLIP DOWN THE CHAIN
	CMPB	#4,TAGTYP(R0)	;SEE IF THIS IS ONE GOODIE
	BNE	READ06		;LOOP IF NO GOOD
	MOV	R0,R3		;SAVE ITS ADDRESS
	SUB	SPTA,R3		;MAKE IT RELATIVE
	ADD	#DATHDR,R2	;GO TO THE DATA ADDRESSES
	MOV	R3,(R2)+	;STORE THE ADDRESS
	MOV	TAGPUL(R0),(R2)	;STORE LENGTH
	DEC	(R2)+		;ADJUST FOR RTS OVERHEAD
	ADD	PNTR(R0),R0	;COMPUTE ADDRESS OF DATA
	SUB	SPTA,R0		;MAKE IT RELATIVE
	INC	R0		;SKIP THE LEADING NEXTS
	MOV	R0,(R2)+	;AND STORE IT FOR LATTER
	BR	READER		;AND GO GET IT NOW

ENDINP:	MOV	SPDA,R4		;GET A DATA AREA POINTER
	ADD	#BASE,R4		;POINT TO THE INPUT BUFFER
	BR	ENDI01		;AND EMPTY IT

INPUTS:	JSR	PC,INPUTC	;SEE IF ANY THERE ETC,ETC
	JSR	PC,BUILDS	;GO SET UP FOR A STRING
	MOV	R3,-(SP)	;SAVE DESTINATION ADDRESS
	JSR	PC,INPUTC	;THIS TIME TO GET ADDRESS OF BUFFER
	MOV	(SP)+,R3	;RESTORE WHERE IT GOES
	MOV	R4,R2		;GET LOCATION OF INPUT STRING
	JSR	PC,SKIP		;SKIP ALL NON BLANKS
	CMPB	#'",(R2)	;SEE IF A FUNNY TERMINATOR
	BEQ	INPS00		;BRANCH IF A QUOTE OF ONE FORM
	CMPB	#'',(R2)	;SEE IF THE OTHER FUNNY ONE
	BNE	INPS01		;BRANCH AROUND UNQUOTE CHARACTER STORE
INPS00:	MOVB	(R2),R4		;UNQUOTE CHARACTER TO R4
	BR	INPS02		;SKIP DEFAULT STORE

INPS01:	MOV	#100000+',,R4	;STORE COMMA PLUS SIGN BIT
	DEC	R2		;FOR THE FOLLOWING INCREMENT
INPS02:	INC	R2		;POP OVER THE STARTER DUDE
	TST	R4		;SEE IF SPACE SUPPRESSION ACTIVE
	BPL	INPS06		;BRANCH IN INSIDE
	JSR	PC,SKIP		;ELSE SKIP SPACES ETC
INPS06:	CMPB	R4,(R2)		;SEE IF THE END IS IN SIGHT
	BEQ	INPS04		;BRANCH IF THE END IS HERE
	CMPB	#015,(R2)	;SEE IF <CR> CHARACTER
	BEQ	INPS02		;ALWAYS IGNORED WHAT A LIFE HE LEADS
	CMPB	#012,(R2)	;SEE IF END OF LINE
	BEQ	INPS03		;BRANCH IF THE END
	CMPB	#033,(R2)	;SEE IF THE OTHER END OF LINE
	BEQ	INPS03		;GO TO THE SAME PLACE
	MOVB	(R2),(R3)+	;STORE THE CHARACTER
	BR	INPS02		;LOOP FOR MORE TO DO

INPS03:	CLR	R4		;CLEAR THE SIGN BIT
INPS04:	TST	R4		;SEE IF UNQUOTE CHARACTER IS SKIPPED
	BGT	INPS05		;BRANCH IF SKIPPED
	DEC	R2		;BACK UP SO AS NOT TO GO FORWARD
INPS05:	INC	R2		;BYPASS THE TERMINATOR
	MOV	R2,R4		;SAVE POINTER TO INPUT
	JSR	PC,@(SP)+	;RETURN TO PBUILDS
	MOV	(SP)+,R5	;GET IPC BACK
	MOV	(R2),(R1)	;SET UP FOR PUSH OF STRING
	JSR	PC,PUSHS2	;PUT IT ON THE LIST
	MOV	R4,R2		;RESTORE THE INPUT POINTER
	MOV	R0,-(SP)	;SAVE SPDA
	ADD	#BASE,(SP)	;NOW IS THE IO HEADER WE NEED
	BR	INPUTT		;AND EXIT TO TERMINATION CHECK

SKIP00:	INC	R2		;KICK THE POINTER
SKIP:	CMPB	#' ,(R2)	;SEE IF <SP>
	BEQ	SKIP00		;BRANCH TO SKIP IT
	CMPB	#'	,(R2)	;SEE IF <TAB>
	BEQ	SKIP00		;SKIP THEM TOO
	TSTB	(R2)		;NULLS A USELESS ALSO
	BEQ	SKIP00		;BYPASS THEM IS PRESENT
	CMPB	#015,(R2)	;SEE IF <CR>
	BEQ	SKIP00		;THEY DISAPEAR TOO
	RTS	PC		;FINALLY PRETURN

INPUTI:	JSR	PC,INPUTC	;CHECK TO SEE THAT WE HAVE INPUT
	MOV	R2,-(SP)	;SAVE BUFFER HEADER ADDRESS
	MOV	R4,R2		;GO TO THE BUFFER ITSELF
	JSR	PC,ATOI		;COLLECT AN INTEGER
	BR	INPUTT		;CHECK THE TERMINATOR STUFF

INPUTF:	JSR	PC,INPUTC	;MAKE SURE THERE'S INPUT TO BE HAD
	MOV	R2,-(SP)	;SAVE BUFFER HEADER ADDRESS
	MOV	R4,R2		;POINT TO THE BUFFER
	JSR	PC,ATOF		;COLLECT A FLOATING NUMBER
INPUTT:	BVS	INPT90		;BRANCH IF BAD FORMAT
INPT01:	MOVB	(R2)+,R3	;GET THE NEXT CHARACTER
	BEQ	INPT01		;BRANCH IF NULL
	CMPB	R3,#' 		;SEE IF A SPACE
	BEQ	INPT01		;LOOP FOR MORE IF A SPACE
	CMPB	R3,#011		;SEE IF A TAB CHARACTER
	BEQ	INPT01		;SKIP TABS TOO
	CMPB	R3,#015		;THE LAST OK NON GOODIE IS <CR>
	BEQ	INPT01		;SKIP THEM ALSO
	CMPB	R3,#',		;SEE IF A , FOR GOODNESS
	BEQ	INPT91		;BRANCH IF OK
	CMPB	R3,#012		;SEE IF A VALID TERMINATOR
	BEQ	INPT91		;DOES THAT HAVE ANYTHING TO DO WITH THE MOON?
	CMPB	R3,#033		;THE FINAL ONE IS <ESC>
	BEQ	INPT91		;<ESC> IS A GOODIE
INPT90:	CLR	R3		;SET ERROR FLAG
INPT91:	MOV	(SP)+,R4	;GET HEADER ADDRESS BACK
	SUB	R4,R2		;COMPUTE NEW CURLOC
	SUB	CURLOC(R4),R2	;CALCULATE BYTES USED
	ADD	R2,CURLOC(R4)	;STORE IT AWAY FOR NEXT TIME
	SUB	R2,BYTCNT(R4)	;AND ADJUST THE COUNT ACCORDINGLY
	TST	R3		;SEE IF ALL GOOD OR NOT
	BNE	INPC00		;BRANCH IF ALL OK
	CLR	BYTCNT(R4)	;EMPTY THE INPUT BUFFER NOW
	BDNERR			;BAD FORMAT
	JSR	PC,INPC99	;SEE WHAT SLOT NUMBER IT IS
	BNE	INPT93		;BRANCH IF NOT THE TTY
	MOV	SCTH,R5		;GET START OF THE STATEMENT
	JMP	UJX5		;MAKE LIKE A GO BUNNY

INPT93:	TRAP	FATAL		;TO THE EDITOR
INPUTL:	JSR	PC,INPUTC	;GET US SOME GOODIES
	MOV	R3,-(R1)	;STORE CHARACTER COUNT
	CLR	BYTCNT(R2)	;EMPTY THE BUFFER
	JSR	PC,BUILDS	;BUILD US A STRING
	MOV	(R1)+,R4	;GET COUNT BACK
	MOV	R0,R2		;GET COPY OF SPDA
	ADD	#BASE,R2	;GO TO TEMP BUFFER
	ADD	CURLOC(R2),R2	;GO TO THE BUFFER
INPL01:	MOVB	(R2)+,(R3)+	;MOVE A BYTE
	SOB	R4,INPL01	;LOOP TILL ALL GONE
	JSR	PC,@(SP)+	;RETURN TO BUILDS
	MOV	(SP)+,R5	;GET R5 BACK
	MOV	(R2),(R1)	;SET UP A LINK
	BR	NUM$02		;EXIT LIKE NUM$

INPUTC:	MOV	SPDA,R2		;GET A DATA AREA POINTER
	ADD	#BASE,R2	;GO TO INPUT BUFFER
	MOV	R2,R4		;COPY HEADER ADDRESS
	ADD	CURLOC(R2),R4	;COMPUTE CURRENT ADDRESS
	MOV	BYTCNT(R2),R3	;GET THE LENGTH REMAINING
	BNE	INPC00		;EXIT NOW IF STUFF THERE
	JSR	PC,INPC99	;SEE IF SLOT 0 AS SOURCE
	BNE	INPC90		;IF NOT 0 THEN AN ERROR
	CLR	-(R1)		;SLOT # OF 0
	JSR	PC,SSI		;GET ANOTHER LINE
	BR	INPUTC		;AND LOOP TO EXIT

INPC90:	NEDERR	!FATAL		;NOT ENOUGH DATA GIVEN

INPC99:	MOV	SPDA,R2		;GET A DATA AREA POINTER
	ADD	CURRIO(R2),R2	;GO TO THE BUFFFER HEADER
	TSTB	SLOT(R2)	;SEE IF ZERO
INPC00:	RTS	PC		;LET CALLER DECIDE

VAL:	JSR	R5,INTFUN	;CALL THE FUNCTION FIXER UPPER
	ARG	FAS		;ONE STRING IS PLENTY
	MOV	R1,R2		;COPY THE STACK POINTER
	MOV	LENGTH(R1),R4	;GET THE LENGTH
	ADD	PNTR(R1),R2	;GET A POINTER TO THE STRING
	ADD	R2,R4		;POINT TO THE END OF THE STRING
	JSR	PC,PSTJS	;POP THE STRING
	MOVB	(R4),-(SP)	;SAVE THE NEXT CHARACTER
	CLRB	(R4)		;STOP THE SCAN
	MOV	R4,-(SP)	;SAVE ITS ADDRESS
	JSR	PC,ATOF		;CALL FOR CONVERSION
	MOV	(SP)+,R4	;RESTORE THE END ADDRESS
	MOVB	(SP)+,(R4)	;REPLACE THE END NEXT CHARACTER
	CMP	R4,R2		;SEE IF ALL THE STRING SCANNED
	BEQ	VAL01		;BRANCH I F OK
	BDNERR			;BAD FORMAT
VAL01:	RTS	PC		;AND RETURN
NUM$:
	JSR	R5,INTFUN	;CALL THE FUNCTION ENTRY DUDE
	ARG	FAF		;FLOATER WANTED
	MOV	#24,R3		;MAXIMUM LENGTH
	JSR	PC,BUILDS	;GO MAKE A STRING
	MOV	R3,-(SP)	;SAVE THE ADDRESS
	JSR	PC,PRINTA	;DO PRINT CONVERSION
	MOV	(SP)+,R3	;RESTORE THE BUFFER ADDRESS
NUM$01:	MOVB	(R2)+,(R3)+	;STORE A CHARACTER
	BNE	NUM$01		;LOOP TILL THE PEND
	DEC	R3		;BACK UP TO THE NULL
	MOV	SPDA,R0		;RESTORE R0 TO SPDA POINTER
	JSR	PC,@(SP)+	;CO-ROUTINE BACK TO BUILDS
	MOV	(SP)+,R5	;RESTORE IPC
	MOV	(R2),(R1)	;SET UP LINK
NUM$02:	JMP	PUSHS2		;AND PUSH AND EXIT
PRINTA:	JSR	PC,FTOA		;GET THE INITIAL SCAN
;	MOV	SPDA,R2		;GET THE DATA AREA POINTER
;	TST	USING(R2)	;SEE IF FUNNY FORMAT
;	BNE	PRNF50		;BRANCH IF LOTS OF WORK TO DO
	MOV	14(R1),R4	;GET THE SCALE FACTOR
	MOV	#-8.,R0		;MAX NUMBER OF DIGITS
	MOV	R1,R2		;COPY THE STACK POINTER
	SUB	#12,R2		;MAKE ROOM FOR THE ENTIRE STRING
	MOV	R2,-(SP)	;SAVE THE POINTER START
	CMPB	(R1),#'0	;SEE IF ONE LEADING ZERO
	BNE	PRNF01		;BRANCH IF SIGNIFICANT DIGIT
	DEC	R4		;ADJUST THE SCALE FACTOR
	INC	R1		;POP OVER THE DIGIT
PRNF01:	INC	R4		;MAKE A FINAL ADJUSTMENT TO SCALE FACTOR
	MOVB	25(R2),R3	;GET THE SIGN  INDICATOR
	BEQ	PRNF08		;SKIP IF POSITIVE NUMBER
	MOVB	R3,(R2)+	;OUTPUT THE MINUS SIGN
PRNF08:	MOV	R1,R3		;SAVE START OF STRING
	SUB	R0,R1		;GO TO TAIL END OF THE STRING
PRNF02:	CMPB	-(R1),#'0	;SEE IF TRAILING ZERO
	BNE	PRNF03		;BRANCH IF NOT 
	INC	R0		;REDUCE SIGFIGS COUNT
	BNE	PRNF02		;BRANCH OF MORE TO TEST
	DEC	R0		;ONE DIGIT FOR NUMBER = 0
	INC	R4		;AND MAKE THE SCALE FACTOR 1
PRNF03:	CMP	R4,#8.		;SEE IF TOO BIG TO PRINT
	BGT	PRNF10		;BRANCH IF E FORMAT REQUIRED
	TST	R4		;SEE IF NEGATIVE
	BGT	PRNF05		;IF POSITIVE OUTPUT SOME NOW
	ADD	R4,R0		;COMPUTE FIELD LENGTH
	CMP	R0,#-8.		;SEE IF TOO LONG
	BLT	PRNF10		;BRANCH FOR E FORMAT
	SUB	R4,R0		;GET SIGFIGS BACK
	MOVB	#'.,(R2)+	;START LITTLES WITH .
	TST	R4		;SEE IF ANY LEADING 0 NEEDED
PRNF04:	BPL	PRNF05		;IF READY GO PUT OUT DIGITS
	MOVB	#'0,(R2)+	;STORE A SPACE HOLDIN 0
	INC	R4		;ADJUST SCALE FACTOR UPWARDS
	BR	PRNF04		;LOOP FOR MORE

PRNF05:	MOVB	(R3)+,(R2)+	;MOVE A REALLY DIGIT
	DEC	R4		;REDUCE THE COUNT
	BGT	PRNF05		;BRANCH IF STILL GOOD NUMBERS TO GO
	BNE	PRNF06		;BRANCH IF PFILLING UP SPACE
	CMP	R3,R1		;SEE OF EMD PF SIGNIFICANCE
	BHI	PRNF07		;EXIT IF ALL DONE
	MOVB	#'.,(R2)+	;STORE A .
	BR	PRNF05		;LOOP FOR MORE GOODIES

PRNF06:	CMP	R3,R1		;SEE IF GOODNESS REMAINS
	BLOS	PRNF05		;BRANCH IF TOO SOON TO QUIT
PRNF07:	MOVB	#' ,(R2)+	;OUTPUT A TRAILING SPACE
	CLRB	(R2)+		;TRAILING NULL FOR PRINTL
	MOV	(SP)+,R2	;RESTORE DATA POINTER
	MOV	R2,R1		;R2 IS A GOOD GUESS
	ADD	#30,R1		;NOW WE HAVE IT
	RTS	PC		;AND RETURN WITH IT ON THE STACK

PRNF10:	MOVB	#'.,(R2)+	;OUTPUT A LEADING .
PRNF11:	MOVB	(R3)+,(R2)+	;MOVE A DIGIT
	CMP	R3,R1		;SEE IF DONE
	BLOS	PRNF11		;LOOP IF MORE DIGITS
	MOVB	#'E,(R2)+	;STORE THE E THINF
	TST	R4		;SEE IF + OR -@
	BPL	PRNF12		;BRANCH IF + OR 0
	MOVB	#'-,(R2)+	;MAKE IT MINUS WHEN IT PRINTS
	NEG	R4		;AND BACK TO +
	BR	PRNF13		;SKIP FOLLOWING STATEMENT

PRNF12:	MOVB	#' ,(R2)+	;OUTPUT THE SIGN(POSITIVE)
PRNF13:	MOV	R2,-(SP)	;SAVE OUR PLACE PLEASE MISTER
	MOV	R2,R1		;FOR FTOA TAIL END
	CLR	R3		;HIGH ORDER OF R4
	MOV	#PRNF14,-(SP)	;RETURN ADDRESS
	MOV	#3.,-(SP)	;COUNTER FOR FTOA06
	MOV	#ATOFTH,R0	;TABEL START
	JMP	FTOA09		;GO FIND THE EXPONENT

PRNF14:	MOV	(SP)+,R2	;RESTORE OUR POSITTION
	CLR	R4		;FOR PRNF05 STUFF
	MOV	R2,R1		;FTOA06 DOES NINE WE WANT FIVE
	MOV	R1,R3		;JUST FIXING UP THE VARIOUS REGISTERS
	ADD	#3.,R1		;FOR PRNF05 LOOP
PRNF15:	CMPB	(R3),#'0	;SEE IF LEADING ZERO
	BNE	PRNF05		;EXIT IF FOUND THE END
	INC	R3		;POP POINTER
	BR	PRNF15		;LOOP THERE MUST BE ONE!!

PSTJS:	MOV	SPDA,R3		;GET SPDA POINTER
	ADD	R1,(R1)		;MAKE THE LINK ABSOLUTE
	MOV	(R1)+,(R3)	;STORE THE NEW START OF THE CHAIN
	SUB	R3,(R3)		;AND MAKE IT RELATIVE
	TST	(R1)+		;POP THE LENGTH AND POINTER
PITJS:	TST	(R1)+		;POP INTEGER OFF THE STACK
	RTS	PC		;AND RETURN

PRINTI:	JSR	PC,FLT		;FLOAT AN INTEGER
PRINTF:	JSR	PC,PRINTA	;CALL FOR CONVERSION
	BR	PRINTL		;AND PRINT IT
;	COMMA OPERATOR ROUTINE

NXTZON:	MOV	SPDA,R3		;GET PDA POINTER
	ADD	CURRIO(R3),R3	;AND LINK TO CURRENT OUTPUT BUFFER
	MOV	POSITN(R3),R0	;GET WHERE WE ARE NOW
	CLR	R4		;THE NEXT PLACE TO BE
CMMA01:	ADD	#14.,R4		;ADD # OF <SP> PER ZONE
	CMP	R0,R4		;SEE IF THIS IS THE NEXT POSSIBLE
	BGE	CMMA01		;BRANCH IF NOT THERE YET
	CMP	R4,MAXLEN(R3)	;SEE IF IT FITS ON THIS LINE
	BGE	CRLF		;BRANCH TO DO A <CR><LF>
	SUB	R0,R4		;CALCULATE # OF SPACES
	MOV	#' ,R2		;SET UP A SPACE
CMMA03:	JSR	PC,PRINTC	;PRINT IT
	DEC	R4		;DECREMENT # TO DO
	BGT	CMMA03		;LOOP IF MORE TO BE DONE
PRS01:	RTS	PC		;AND RETURN

;	PRINT STRING ROUTINE

PRINTS:	MOV	R1,R0		;COPY THE STACK POINTER
	ADD	PNTR(R0),R0	;POINT TO THE STRING
	MOV	LENGTH(R1),R4	;GET THE LENGTH
	JSR	PC,PSTJS	;GET RID OF THE STRING
	MOV	#SPDA,R3	;GET POINTER TO RELOCATION FACTOR
PRS00:	DEC	R4		;DECREMENT THE COUNTER
	BLT	PRS01		;BRANCH IF DONE
	MOVB	(R0)+,R2	;GET A CHARACTER
	SUB	(R3),R0		;MAKE RELATIVE
	JSR	PC,PRINTC	;PRINT IT
	ADD	(R3),R0		;MAKE ABSOLUTE AGAIN
	BR	PRS00		;LOOP FOR MORE

PRL40:	.WAIT			;SOME ONE WILL GIVE UP SOON
PRL30:	CMP	@IOSTS,#EOF	;SEE IF OUT OF DISK ROOM
	BNE	PRL99		;BRANCH IF OTHER THAN NO ROOM
	BUFFER,GETSML		;GET A LITTLE BITTY BUFFER
	BVS	PRL40		;BRACH TO WAIT A WHILE
	MOV	R4,-(SP)	;SAVE THE FIRQB TO BE ADDRESS
	CLR	(R4)+		;PASS UP THE LINK WORD
	MOVB	JOB,(R4)+	;STORE THE JOB NUMBER
	CLRB	(R4)+		;AND THE FUNCTION--EXTEND
	ADD	(R0),R3		;GET A REAL POINTER TO THE BUFFER HEADER
	MOVB	SLOT(R3),(R4)+	;SHOW HIM WHICH ONE
	SUB	(R0),R3		;MAKE R3 RELATIVE AGAIN
	MOVB	#1,(R4)+	;WE WANT JUST ONE MORE SEGMENT
	MOV	(SP)+,R4	;RESTORE THE START OF THE FIRQB
	CALFIP			;GO THRASH THE DISK
	BUFFER,RETSML		;RETURN WHAT IS NOT RIGHTLY OURS
	TST	@IOSTS		;SEE IF ANY ERRORS
	BEQ	PRL25		;IF OK THEN WRITE IT AGAIN
PRL99:	ADD	(R0),R1		;MAKE R1 A REAL POINTER
	ADD	(R0),R5		;AND R5 TOO
	IOTERR	!FATAL		;TYPE IT OUT
CRLF:	MOV	#MSG2,R2	;OUTPUT A <CR><LF>
PRINTL:	JSR	R4,SAVEM	;SAVE R4,R3,R2,R0
PRL01:	MOV	SPDA,R3		;GET THE LOCATION OF THE PDA
	MOV	#JOBORG,R0	;GET THE JOB'S CORE ADDRESS
	ADD	CURRIO(R3),R3	;GET THE ADDRESS OF THE BUFFER HEADER
	BISB	#WRTARY,FLAGS(R3)	;SET MEDDLED BIT
	MOV	LENGTH(R3),-(SP);GET THE LENGTH OF IT
	SUB	BYTCNT(R3),(SP)	;COMPUTE THE BYTES REMAINING
	MOV	R3,R4		;COPY THE HEADER ADDRESS
	ADD	CURLOC(R4),R4	;POINT TO THE CURRENT POSITION
PRL00:	DEC	(SP)		;SEE IF ANY MORE ROOM
	BLT	PRL10		;IF NOT THEN OUTPUT THE BUFFER
	CMPB	#015,(R2)	;SEE IF A CR
	BNE	PRL04		;BRANCH IF PRINTING-MAYBE
	CLR	POSITN(R3)	;GO TO START OF THE LINE
PRL04:	CMPB	#040,(R2)	;SEE IF PRINTABLE
	BGT	PRL05		;BRANCH IF NO MARK GENERATED
	INC	POSITN(R3)	;TALLY A CHARACTER PRINTED
PRL05:	MOVB	(R2)+,(R4)+	;MOVE A CHARACTER
	TSTB	(R2)		;SEE IF MORE TO DO
	BNE	PRL00		;IF NOT NULL THEN GO AGAIN
	SUB	R3,R4		;MAKE IT RELATIVE
	MOV	R4,CURLOC(R3)	;STORE THE UPDATED COUNT
	MOV	LENGTH(R3),BYTCNT(R3)	;GET READY FOR THE FINAL CALC.
	SUB	(SP)+,BYTCNT(R3);COMPUTE THE BYTE COUNT USED
	BEQ	PRL02		;EXIT OF NOTHING IN THE BUFFER
	BITB	#FORCE,FLAGS(R3);SEE IF OUTPUT NOW OR LATTER
	BNE	PRL20		;BRANCH IF NOW
PRL02:	BR	RESTEM		;RESTORE THE REGISTERS

PRL10:	MOV	LENGTH(R3),BYTCNT(R3)	;SHOW A FULL BUFFER
	MOV	PNTR(R3),CURLOC(R3)	;AND LOCATION TO BUFFER START
	CLR	-(SP)		;A FLAG FOR R2 RELOCATABILITY
	CMP	R2,(R0)		;SEE IF OURS OR HIS MESSAGE
	BLO	PRL11		;BRANCH IF PART OF US
	SUB	(R0),R2		;SUBTRACT RELOCATION
	COM	(SP)		;FLAG IT FOR LATTER
PRL11:	MOV	#PRL12,-(SP)	;RETURN TO PRL12
	JSR	R4,SAVEM	;SAVE THE REGS
	BR	PRL20		;OUTPUT THE BUFFER

PRL12:	MOV	(SP)+,(SP)+	;SEE WHERE THE MESSAGE IS
	BEQ	PRL01		;IF IN US GO NOW
	ADD	(R0),R2		;RELOCATE IT
	BR	PRL01		;NOW GO AGAIN

PRL20:	MOV	PNTR(R3),CURLOC(R3)	;SET UP TO START AT THE BEGINNING
	SUB	(R0),R1		;MAKE THE ABS POINTERS
	SUB	(R0),R3		;  INTO HARMLESS RELATIVE
	SUB	(R0),R5		;    NUMBERS
PRL25:	.WRITE			;HAY NATE GET ON THE STICK
	TST	@IOSTS		;SEE IF ANY ERRORS
	BNE	PRL30		;BRANCH IF OUT OF DISK NOW
	ADD	(R0),R1		;MAKE THOSE HARMLESS
	ADD	(R0),R3		;  NUMBERS INTO USE-
	ADD	(R0),R5		;    FULL POINTER AGAIN
	BICB	#WRTARY,FLAGS(R3)	;CLEAR REWRITE BIT
	MOV	PNTR(R3),CURLOC(R3)	;START ALL OVER
	CLR	BYTCNT(R3)	;WITH THE BUFFER EMPTY

RESTEM:	MOV	(SP)+,R0	;RESTORE R4,R3,R2,R0 AND EXIT
	MOV	(SP)+,R2
	MOV	(SP)+,R3
	MOV	(SP)+,R4
	RTS	PC

PRINTC:	JSR	R4,SAVEM	;SAVE THE REGS
	CLR	-(SP)		;CLEAR THE "LINE"
	MOVB	R2,(SP)		;STORE THE WHOLE LINE
	MOV	SP,R2		;SET UP FOR PRINTL
	JSR	PC,PRINTL	;GO OUTPUT A "LINE"
	TST	(SP)+		;REMOVE THE OUTPUT AREA
	BR	RESTEM

SAVEM:	MOV	R3,-(SP)	;SAVE R4,R3,R2,R0
	MOV	R2,-(SP)
	MOV	R0,-(SP)
	MOV	R4,PC


MSG2:	.BYTE	15,12,0,0		;CRLF STRING
SSO99:	CCC			;NO BITS ON
	CMP	ST,#PR1		;SEE IF OK TO USE
	BEQ	SSO01		;BRANCH IF DEBUGGED CODE
	BSERR	!FATAL		;BAD SLOT FOR THE USER
SSO:	MOV	(R1),R3		;SEE IF IN RANGE
	CMP	R3,#12.		;SEE IF IN RANGE
	BHI	SSO99		;BRANCH IF AN ERROR
SSO01:	ASL	R3		;NOW IS SLOT * 2
	ASL	R3		;NOW IS SLOT * 4
	ASL	R3		;NOW IS SLOT * 8
	ASL	R3		;MAKE IT A WORD INDEX
	ADD	#BASE+IOLEN,R3	;AND SKIP OVER THE CONSTANT STUFF
	MOV	SPDA,R2		;GET THE PDA POINTER
	MOV	R3,CURRIO(R2)	;STORE THE BUFFER HEADER ADDRESS
CLSR99:	MOV	(R1)+,R4	;GET THE SLOT #
	ASL	R4		;MAKE IT A WORD INDEX
	ADD	@JOBDA,R4	;R2 NOW PONTTS TO THE FCB-DDB ADDRESS
	RTS	PC		;AND EXIT

CLOSER:	TST	(R1)		;SEE IF TTY
	BEQ	CLSR99		;EXIT NOW IF NOTHING TO DO
	JSR	PC,SSO		;CALCULATE BUFFER ADDRESS
	MOV	R3,-(SP)	;SAVE RELATIVE ADDRESS OF HEADER
	ADD	R2,R3		;MAKE ABSOLUTE
	MOVB	SLOT(R3),-(SP)	;SAVE THE SLOT NUMBER
	ASL	-(R1)		;GET SLOT * 2
	CLR	R0		;A REWRITE FLAG
	ADD	ARYPTR(R2),R2	;GO TO THE FIRST ITEM
CLSR03:	CMPB	SLOT(R2),(R1)	;SEE IF IT MATCHES
	BNE	CLSR06		;BRANCH IF NO MATCH
	BITB	#WRTARY,FLAGS(R2)	;SEE IF THE MEDDLED BIT IS ON
	BEQ	CLSR06		;BRANCH IF NOTHING YET
	BICB	#WRTARY,FLAGS(R2)	;FOR NEXT TIME CLEAR IT
	INC	R0		;SHOW THE NEED FOR RE-WRITE
CLSR06:	TST	(R2)		;SEE IF END OF THE TRAIL
	BEQ	CLSR08		;BRANCH IF NO MORE
	ADD	(R2),R2		;SKIP DOWN THE CHAIN
	BR	CLSR03		;AND LOOP TILL DONE

CLSR08:	TST	(R1)+		;POP OFF THE SLOT NUMBER
	TST	R0		;AND SEE IF REWRITE NEEDED
	BEQ	CLSR10		;BRANCH IF EASY THIS TIME
	MOV	#CLSR10,-(SP)	;RETURN ADDRESS
	MOV	#JOBORG,R0	;GET POINTER FOR RELOCATION
	JSR	R4,SAVEM	;SAVE THE REGISTERS
	BR	PRL20		;CALL PRINTL FOR SERVICE

PROMPT:	.BYTE	'?,' ,0,0
SSI06:	MOV	SPDA,R4		;GET DATA AREA POINTER
	MOV	WAITTM(R4),R4	;GET USER SPECIFIED WAIT INTERVAL
	TSTB	SLOT(R3)	;SEE IF SLOT 0
	BNE	SSI07		;IF NOT THEN NO ?
	SUB	(R0),R2		;MAKE OUR IMPORTANT REGS RELATIVE
	SUB	(R0),R3		;THAT IS R2 AND R3
	MOV	R2,-(SP)	;AND SAVE R2
	MOV	#PROMPT,R2	;SET UP THE ?
	.TTRST			;ELIMINATE ^O EFFECT
	JSR	PC,PRINTL	;PRINT IT
	MOV	(SP)+,R2	;GET BUFFER HAEADER POINTER BACK
	ADD	(R0),R2		;MAKE ABSOLUTE AGAIN
	ADD	(R0),R3		;BOTH OF THEM
	BR	SSI07		;AND GO GET A BUFFER FULL

CLSR10:	BUFFER,GETSML		;GET A FIRQB
	BVS	OPNR99		;IF NONE WAIT A MINUTE
	MOV	R4,R0		;COPY THE ADDRESS
	CLR	(R0)+		;CLEAR THE LINK WORD
	MOVB	JOB,(R0)+	;AND OUR JOB NUMBER
	MOVB	#CLSFQ,(R0)+	;THE FUNCTION
	MOVB	(SP)+,(R0)+	;AND THE SLOT NUMBER
	JSR	PC,FIPCAL	;CALL FIP PROCESSOR
	BUFFER,RETSML		;RETURN THE FIRQB
	CLR	R0		;ZERO BUFFER LENGTH
	MOV	(SP)+,R2	;SET UP R2 FOR BUFFER ALLOCATOR
	JMP	THENT		;DE-ALLOCATE THE BUFFER

SSI:	JSR	PC,SSO		;GO SELECT AND SET UP CURRIO
	ADD	R2,R3		;COMPUTE ADDRESS OF I/O HEADER
	ADD	#BASE,R2	;R3 IS FOR THE INPUT LINE
	TST	BYTCNT(R2)	;SEE IF IT'S EMPTY
	BGT	SSI03		;BRANCH IF NO QUITE EMPTY
	MOV	PNTR(R2),CURLOC(R2)	;SET UP CURLOC FOR THE EXIT
	CLR	BYTCNT(R2)	;ZERO THE BYTE COUNT
SSI03:	MOV	R2,R0		;COPY THE TWO
	MOV	R3,R4		;  BUFFER HEADER POINTERS
	ADD	CURLOC(R0),R0	;R0 HAS BUFFER ADDRESS
	ADD	BYTCNT(R2),R0	;ADJUST FOR PARTIAL BUFFER
	ADD	CURLOC(R4),R4	;R4 IS FOR THE LINE TO BE
SSI00:	DEC	BYTCNT(R3)	;SEE IF ANY INPUT LEFT
	BLT	SSI04		;BRANCH IF IO NEEDED
	MOVB	(R4)+,(R0)	;MOVE THE CHARACTER
	BICB	#200,(R0)	;CLEAR THE PARITY BIT ON TAPE
	BEQ	SSI00		;IF A NULL IGNORE IT
	CMPB	#177,(R0)	;SEE IF RUBOUT
	BEQ	SSI00		;IF SO TOO BAD FOR IT
	CMPB	#012,(R0)	;SEE IF ^J
	BEQ	SSI02		;BRANCH IF A <LF>
	CMPB	#033,(R0)	;SEE IF <ESC>
	BEQ	SSI08		;BRANCH IF FOUND
	INC	R0		;GO TO THE NEXT CHARACTER IN THE OUTPUT BUFFER
	INC	BYTCNT(R2)	;SHOW THE MOVED CHARACTER
	CMP	BYTCNT(R2),LENGTH(R2)	;SEE IF ANY ROOM LEFT
	BLO	SSI00		;BRANCH IF OK
SSI11:	CLR	BYTCNT+IOLEN(R2);CLEAR ANY TTY INPUT NOW
	JSR	PC,SSI08	;CLOSE OUT THE CREATION OF THE BUFFER
	LINERR			;TELL PEOPLE THAT IT'S TOO LONG
	RTS	PC

SSI02:	CMPB	-1(R0),#015	;SEE IF PRECEEDED BY ^M
	BNE	SSI09		;IF LONELY LF BRANCH
SSI08:	INC	BYTCNT(R2)	;SHOW THE FINAL <LF>
	SUB	R3,R4		;THE NEW CURLOC
	TST	BYTCNT(R3)	;SEE IF FORCED BUFFER(OR EMPTY)
	BNE	SSI05		;IF STILL SOME THERE BRANCH
	MOV	PNTR(R3),R4	;ELSE SHOW THE START OF THE BUFFER
SSI05:	MOV	R4,CURLOC(R3)	;STORE IT AWAY
	RTS	PC		;AND RETURN

SSI04:	CLR	BYTCNT(R3)	;EMPTY OUT THE BUFFER
	MOV	#JOBORG,R0	;GET RELOCATION POINTER
	CLR	R4		;CLEAR WAIT TIME
	CMP	ST,#PR1!Z	;SEE IF EDITOR OR USER
	BNE	SSI06		;BRANCH TO OUTPUT A ?
SSI07:	MOV	PNTR(R3),CURLOC(R3)	;START AT THE BEGINNING OF THE LINE
	SUB	(R0),R1
	SUB	(R0),R3		;MAKE THESE REGISTERS
	SUB	(R0),R5		;  RELATIVE ADDRESS
	SUB	(R0),R2
	.READ			;CALL NATE FOR IO SERVICE
	ADD	(R0),R1
	ADD	(R0),R3		;BACK TO ABSOLUTE
	ADD	(R0),R5		;  POINTER AGAIN
	ADD	(R0),R2
	TSTB	@JOBF		;SEE IF ^C TYPED
	BMI	SSI10		;BRANCH IF TIME TO EXIT
	TST	@IOSTS		;SEE IF EOF-MAYBE
	BNE	SSI12		;BRANCH IF AN ERROR
	MOV	PNTR(R3),CURLOC(R3)	;START AT THE BEGINING OF THE BUFFER
	BR	SSI03		;AND CONTINUE

OPNR90:	BUFFER,RETSML		;RETURN FIRQB
	IOTERR	!FATAL		;IF NOT OPPENED THEN REAL TROUBLE

OPNR99:	DEC	R5		;BACK UP TO CLOSE OPCODE
	TST	-(R1)		;AND RECOVER THE SLOT NUMBER
	JMP	SHUT01		;AND SLEEP FOR A WHILE

SSI10:	CMP	ST,#PR1!N	;SEE IF EDITOR CALLING
	BEQ	SSI14		;IF EDITOR LEAVE THIS WAY
	DEC	R5		;BACK UP IPC LIKE NATHAN DOES TO US
	JMP	SHUT02		;AND STOP NICELY

SSI12:	CLR	BYTCNT(R2)	;EMPTY THE BUFFER
	IOTERR			;LOG THE ERROR AND HANDLE IF SO REQUESTED
	CMP	ST,#PR1		;SEE IF EDITOR OR RTS CALLING
	BNE	SSI13		;BRANCH IF THE USER
SSI14:	JMP	EDERRN		;GO TO TERMINATE THE OLD COMMAND

SSI13:	TRAP	FATAL		;GO TO EDERR IF EDITOR

SSI09:	ADD	#2,BYTCNT(R2)	;UPDATE CHARACTER COUNT
	CMP	BYTCNT(R2),LENGTH(R2)	;SEE IF ANY ROOM LEFT
	BHIS	SSI11		;BRANCH IF ERROR
	INC	R0		;POP OVER THE LF
	MOVB	#015,(R0)+	;ENTER A ^M
	CLRB	(R0)+		;AND A NULL
	BR	SSI08		;AND EXIT

OPNR10:	JSR	PC,CLOSER	;CLOSE THE SLOT IF OPEN NOW
	MOV	-2(R1),R2	;GET THE SLOT #
OPNR20:	BUFFER,GETSML		;GET SMALL BUFFER FROM NATE-ADDR IN R4
	BVS	OPNR99		;GO AWAY FOR A WHILE IF AN ERROR
OPNR30:	MOV	R4,R3		;COPY THE FIRQB TO BE ADDRESS
	CLR	(R3)+		;CLEAR THE LINK WORD
	MOVB	JOB,(R3)+	;STORE JOB # IN FIRQB
	MOVB	#CSIFQ,(R3)+	;STORE FUNCTION
	MOV	R2,(R3)+	;STORE IT IN THE FIRQB
	MOV	R1,(R3)+	;SHOW HIM WHERE THE STACK IS
	JSR	PC,PSTJS	;GET RID OF THE STRING
	.LOCK			;LOCK HIM IN CORE
	JSR	PC,FIPCAL	;CALL FIP TO DO THE REST
	BNE	OPNR90		;BRANCH IF BAD NAME
	RTS	PC		;AND RETURN

OPNR31:	XCDCOR	!FATAL		;TOO BAD DAD

THENT:	MOV	SPDA,R4		;GET A POINTER TO THE DATA AREA
	JSR	PC,SVACRG	;SAVE R1 AND R5 FOR LATER
	MOV	R0,-(SP)	;SAVE LENGTH WANTED IN CASE OF RETRY
	BLT	OPNR31		;BRANCH IF TOO BIG TO ALLOCATE
	MOV	R2,-(SP)	;AND BUFFER HEADER ADDRESS TOO.
	ADD	R4,R2		;CALCULATE ABSOLUTE ADDRESS OF HEADER
	MOV	LENGTH(R2),R5	;GET THE CURRENT LENGTH
	BNE	OPNR32		;BRANCH IF EXPAND
	CLR	PNTR(R2)	;CLEAR THE POINTER
OPNR32:	MOV	R0,R1		;STORE THE NEW LENGTH
	SUB	R5,R0		;COMPUTE SIZE CHANGE
	BLT	OPNR40		;BRANCH IF A REDUCTION
	BEQ	OPNR50		;I DON'T EXPECT TO BRANCH MUCH AT ALL
	MOV	PLD(R4),R3	;GET + LIMIT OF STORAGE
	SUB	PDD(R4),R3	;COMPUTE THAT STILL FREE
	CMP	R0,R3		;SEE IF WE HAVE ENOUGH ROOM
	BLE	OPNR40		;BRANCH IF ROOM TO WORK
	MOV	R0,-(SP)	;SAVE THE SIZE CHANGE
	MOV	R0,STRNOM(R4)	;SHOW OUR DIRE NEED FOR CORE
	SUB	R4,R2		;RELATIVIZE BUFFER HEADER
	JSR	R5,ALLOC	;SAVES R1 ON SP
	STROUT			;LOADS R1RING FOR CORE ALLOCATOR
	MOV	R0,R4		;RESTORE SPDA
	ADD	R4,R2		;ABSOLUTIZE BUFFER HEADER
	MOV	(SP)+,R0	;AND RECALL THE SIZE CHANGE
OPNR40:	MOV	R1,LENGTH(R2)	;STORE THE NEW LENGTH
	MOV	PNTR(R2),R3	;GET THE POINTER
	BNE	OPNR41		;IF BY CHANCE ITS THERE ALREADY
	MOV	PSD(R4),R3	;GET STATIC UPPER ADDRESS
	ADD	R4,R3		;A LITTLE PUSSY-FOOTING
	SUB	R2,R3		;AND WE HAVE A PNTR
	MOV	R3,PNTR(R2)	;SET IT UP IN CORE
OPNR41:	ADD	R3,R2		;POINT TO THE BUFFER
	ADD	R5,R2		;NOW TO THE END OF THE OLD BUFFER
	MOV	PDD(R4),R3	;GETS US THE DYNAMIC LIMIT
	ADD	R4,R3		;MAKES ABSOLUTE
	MOV	R0,R5		;SEE IF GETTING BIGGER OR SMALLER
	BLT	OPNR43		;BRANCH IF COLLAPSE
	ADD	R3,R5		;COMPUTE NEW UPPER LIMIT
	CMP	(R3)+,(R5)+	;A LITTLE BUSY WORK FOR THE FAST LOOP
OPNR42:	MOV	-(R3),-(R5)	;MOVE A WORD
	CMP	R2,R3		;SEE IF DONE
	BLO	OPNR42		;BRANCH IF JOB IS NOT DONE
	BR	OPNR44		;NOW SKIP COLLAPSE

OPNR43:	ADD	R2,R5		;COMPUTE LOWER BUFFER COLLAPSE ADDRESS
	MOV	R2,-(SP)	;SAVE R2
OPNR51:	MOV	(R2)+,(R5)+	;MOVE(COLLAPSE) A WORD
	CMP	R5,R3		;SEE IF DONE
	BLOS	OPNR51		;LOOP IF MORE TO DO
	MOV	(SP)+,R2	;RESTORE THE POSITION
	DEC	R2		;SO NO ONE MATCHES NOTHING
OPNR44:	ADD	R0,PSD(R4)	;ADJUST DATA AREA
	ADD	R0,PDD(R4)	;BASE POINTERS
	MOV	R4,R5		;COPY PDA POINTER
OPNR45:	TST	(R5)		;SEE IF THE END OF THE ROAD
	BEQ	OPNR46		;GO TO ARRA UPDATE IF SO
	MOV	R5,R1		;COPY THE POINTER
	ADD	(R5),R1		;SEE WHERE THE NEXT STRING MIGHT BE
	CMP	R1,R2		;SEE IF AFFECTED BY THE JUGGLING DONE
	BHI	OPNR52		;BRANCH IF OUT THERE
	MOV	R1,R5		;ELSE UPDATE LINK POINTER
	ADD	R0,PNTR(R5)	;ADJUST FOR ITS NEW POSITION
	BR	OPNR45		;AND LOOP FOR MORE

OPNR52:	ADD	R0,(R5)		;LINK NEEDS CHANGING
	ADD	(R5),R5		;NOW IT DOES THE TRICK
OPNR53:	TST	(R5)		;SEE IF IT ENDS OUT HERE
	BEQ	OPNR46		;IF SO WE CAN CONTINUE ELSEWHERE
	MOV	R5,R1		;COPY THE POINTER
	ADD	(R1),R5		;SKIP DOWN THE LINK
	CMP	R5,R2		;SEE IF BACK TO HOME YET
	BHI	OPNR53		;BRANCH IF MORE OUT HERE
	SUB	R0,(R1)		;ADJUST THE LINK THUSLY
	MOV	R1,R5		;AND PUT IT IN THE RIGHT REGISTER
	BR	OPNR45		;AND LOOP MORE DOWN LOW

OPNR46:	MOV	R4,R5		;COPY PDA POINTER AGAIN
	ADD	ARYPTR(R5),R5	;GO TO BUFFER LINK WORD
	BR	OPNR48		;GO TO HANDLE FIRST ENTRY

OPNR47:	TST	(R5)		;SEE IF ANY LEFT
	BEQ	OPNR50		;BRANCH IF DONE
	ADD	(R5),R5		;SKIP THE ROPE
OPNR48:	MOV	R5,R1		;COPY HEADER POINTER
	ADD	PNTR(R1),R1	;COMPUTE WHERE IT IS (WAS)
	CMP	R1,R2		;SEE IF ABOVE OR BELOW ADDITION
	BLOS	OPNR47		;BRANCH IF NO ADJUSTMENT NEEDED
	ADD	R0,PNTR(R5)	;ELSE ADJUST ACCORDINGLY
	BR	OPNR47		;LOOP FOR MORE

OPNR50:	MOV	(SP)+,R2	;RESTORE BUFFER HEADER POINTER
	MOV	(SP)+,R0	;RESTORE DESIRED LENGTH
	JMP	RSACRG		;GET ACTIVE REGISTERS BACK
OPNI90:	BUFFER,RETSML		;RETURN FIRQB
OPNO92:	IOTERR	!FATAL		;FILE NOT FOUND

OPENI:	JSR	PC,OPNR10	;CLOSE OLD FILE AND SCAN NEW ONE
	JSR	PC,OPNI10	;DO THE OPEN AND ALLOCATE THE BUFFER
	BISB	#FCWRIT,FCSTS(R4)	;SET NO WRITING
OPNI23:	TSTB	R0		;SEE IF DISK
	BNE	OPNI25		;BRANCH IF NO READ AHEAD
	TST	FCSIZ(R4)	;SEE IF ANY BLOCKS IN IT
	BEQ	OPNI25		;IF NO BLOCKS DON'T READ AHEAD
	JSR	PC,SVACRG	;IF SO SAVE REGISTERS
	MOV	R2,R3		;COPY HEADER ADDRESS
	SUB	JOBORG,R3	;MAKE RELATIVE TO CORE AREA
	.READ			;AND READ THE FIRST BLOCK
	ADD	JOBORG,R3	;MAKE ABSOLUTE AGAIN
	MOV	R3,R2		;AND IN OUR FAVORITE REGISTER
	JSR	PC,RSACRG	;RESTORE REGISTERS
	DEC	FCNLB(R4)	;BACK UP FOR POSSIBLE REWRITE
	CLR	BYTCNT(R3)	;MAKE EMPTY IF ASCII OUTPUT
OPNI25:	TST	@IOSTS		;SEE IF ANY CAUSE FOR CONCERN
	BNE	OPNO92		;BRANCH IF BADDNESS
	RTS	PC		;AND RETURN

OPENO:	JSR	PC,OPNR10	;CLOSE THE SLOT FIRST AND SCAN THE STRING
OPNO10:	MOVB	#CREFQ,FQFUN(R4);CREATE IT
	JSR	PC,FIPCAL	;CALL NAT IN
	BNE	OPNI90		;IF NOT OK THEN EXIT
OPNI10:	MOVB	#OPNFQ,FQFUN(R4);TRY TO OPEN IT
	JSR	PC,FIPCAL	;CAL FILE PROCESSOR
	BNE	OPNI90		;IF NOT ZERO IS ALL OVER
OPNI20:	MOV	R2,R4		;GET THE SLOT INDEX
	ADD	@JOBDA,R4	;COMPUTE FCB ADDRESS
	MOV	(R4),R4		;GET THE FCB ADDRESS
	MOVB	(R4),R0		;GET THE HANDLER INDEX
	MOV	SIZES(R0),R0	;GET NEEDED BUFFER SIZE
	ASL	R2		;MAKE SLOT INDEX
	ASL	R2		;  INTO A BUFFER HEADER
	ASL	R2		;    INDEX POINTER
	ADD	#BASE+IOLEN,R2	;GET BUFFER ADDRESS
	MOV	R4,-(SP)	;KEEP HANDLER INDEX
	JSR	PC,THENT	;GO TO THE ROUTINE TIM & I SHARE
	ADD	R4,R2		;GOTO ABSOLUTE BUFFER ADDRESS
	MOV	PNTR(R2),CURLOC(R2)	;MOVE CURLOC
	CLR	BYTCNT(R2)	;AND MAKE IT REAL EMPTY
	MOV	(SP)+,R4	;RESTORE FCB POINTER
	MOVB	(R4),R0		;GET HANDLER INDEX AGAIN
	MOVB	IOFLG(R0),FLAGS(R2)	;SET IO FLAGS IN STATUS BYTE
	MOV	IOMLN(R0),MAXLEN(R2)	;SET MAX LINE LENGTH FOR COMMA'S
	RTS	PC		;AND RETURN
OPENIO:	JSR	PC,OPNR10	;CLOSE SCAN ETC
	MOVB	#OPNFQ,FQFUN(R4);SET TO TRY OPEN
	JSR	PC,FIPCAL	;LET NAT IN ON THE ACTION
	BEQ	OPNI30		;IF OK DO OPEN
	CMP	#NOSUCH,@IOSTS	;SEE IF NOT THERE ERROR
	BEQ	OPNO10		;IF NOT THERE CREATE
	BUFFER,RETSML		;RETURN FIRQB
OPNI92:	IOTERR	!FATAL		;IT'S THERE BUT NO CAN HAVE

OPNI30:	MOV	#OPNI23,-(SP)	;STORE RETURN ADDRESS
	BR	OPNI20		;DO MOSTLY LIKE OPEN

KILLER:	JSR	PC,OPNR20	;GET A FIRQB AND SCAN THE FIRST NAME
	MOVB	#DLNFQ,FQFUN(R4);SET UP TO DELETE BY NAME
	JSR	PC,FIPCAL	;INVOKE THE FILE SYSTEM
	BNE	OPNI90		;BRANCH IF ANY ERROR
	RTS	PC		;AND EXIT IF OK

NAMER:	JSR	PC,OPNR20	;GET A FIRQB AND SCAN THE NAME
	MOV	R4,R3		;SET UP FOR THE SAVE
	MOV	FQPROT(R4),-(SP);SAVE PROTECTION
	ADD	#6,R3		;SKIP HOUSKEEPING STUFF
	MOV	#4,R2		;A COUNT OF THE NUMBER OF WORDS TO SAVE
NAMR01:	MOV	(R3)+,-(SP)	;MOVE A WORD
	SOB	R2,NAMR01	;LOOP IF MORE TO DO
	JSR	PC,OPNR30	;GET THE SECOND NAME
	MOV	R4,R3		;SET POINTER FOR THE
	ADD	#FQNAM2+6,R3	;  INSERTION OF THE FIRST NAME
	MOV	#4,R2		;SET UP THE COUNTER
NAMR02:	MOV	(SP)+,-(R3)	;MOVE A WORD OF THE SECOND NAME
	SOB	R2,NAMR02	;LOOP IF MANY WORDS LEFT
	MOVB	#RENFQ,FQFUN(R4);SET RENAME FUNCTION
	MOV	(SP)+,FQPROT(R4);STORE NEW PROTECTION
	JSR	PC,FIPCAL	;CALL THE FILE PROCESSOR
	BUFFER,RETSML		;BEE A GOOD BOY AND RETURN THE CORE
	BNE	OPNI92		;BRANCH IF AN ERROR
	RTS	PC		;OR RETURN

SVACRG:	MOV	R1,R1RING	;SAVE R1 IN ITS SPECIAL PLACE
	MOV	R5,R5RING	;AND THE SAME FOR R5
	RTS	PC		;AND RETURN

FIPCAL:	JSR	PC,SVACRG	;SAVE THE GOOOD ONES
	CALFIP			;DO THE MONITOR EMT
RSACRG:	MOV	R1RING,R1	;RESTORE R1
	MOV	R5RING,R5	;AND R5 WITH ANY APPROIATE ADJUSTMENT
	TST	@IOSTS		;AND THIS IS OUR PUBLIC SERVICE
	RTS	PC		;AND RETURN
UUOCON:	JSR	R5,INTFUN	;MAKE SURE ITS A STRING FOR US
	ARG	FAS		;STRING ONE ONLY PLEASE
	MOV	R1,R3		;COPY THE STACK POINTER
	ADD	PNTR(R1),R3	;POINT TO THE REAL STRING
	MOVB	(R3)+,R0	;GET THE DISPATCH BYTE
	ASL	R0		;MULTIPLY BY TWO FOR WORD INDEX
	CMP	R0,#UUOMAX	;SEE IF TOO BIG
	BHI	UUO99		;BRANCH IF TOO HIGH
	ADD	R0,PC		;FAST BRANCH DISPATCH
	BR	UUOXIT		;EXIT TO EDITOR
	BR	UUOFIP		;CALL FILE PROCESSOR
	BR	UUOECH		;.TTECH--START THE WORLD I WANT TO GET ON
	BR	UUOTPE		;.TTAPE--ENTER TAPE MODE
	BR	UUONCH		;.TTNCH--TURN OF ECHO LIKE FOR PASSWORD
	BR	UUORST		;.TTRST--CANCELS ^O STUFF
	BR	EDORIT		;EXIT AND SET UP NONAME PROG
	BR	UUO999		;USER SUPPLIED FUNCTION
UUOMAX	=	16		;2*NUMBER OF ENTRIES IN THE TABLE

EDORIT:	JMP	EDITOR		;JUST LIKE NEW THIS TIME

UUOXIT:	JSR	PC,PSTJS	;AND GET RID OF THE STRING
	CHGPR	PR1		;GO TO EDTOR LEVEL
	MOV	SPDA,R0		;SET UP R0 FOR THE EDITOR
	JMP	EDEXIT

UUOECH:	.TTECH			;DO A TTY ECHO ON STUFF
UUONOP:	RTS	PC		;AND RETURN

UUOTPE:	.TTAPE			;ANOTHER IN A LONG CHAIN OF TTCALLS
UUO999:	RTS	PC		;AND RETURN

UUONCH:	.TTNCH			;TURN OF ALL! ECHO TO TTY
UUOKEE:	RTS	PC		;AND RETURN INCOGNITO

UUO99:	BADUUO	!FATAL		;AND GO TELL HIM

UUORST:	.TTRST			;CANCEL ^O
	RTS	PC

UUO01:	.WAIT			;WAIT A SPELL
UUOFIP:	BUFFER,GETSML		;GET A LITTLE BUFFER
	BVS	UUO01		;LOOP IF NONE
	MOV	R4,R3		;COPY THE POINTER
	CLR	(R3)+		;SKIP THE LINK
	MOVB	JOB,(R3)+	;ENTER THE JOB NUMBER
	MOVB	#UUOFQ,(R3)+	;ENTER THE FUNCTION
	MOV	R1,(R3)+	;ENTER OUR STACK POINTER
	.LOCK			;SORRY ALL YOU OTHER PEOPLE
	JSR	PC,FIPCAL	;CALL THE FILE PROCESSOR
	MOV	R4,-(SP)	;SAVE THE FIRQB ADDRESS
	MOV	@IOSTS,(R4)	;COPY IO STATUS
	MOV	#32.,R3		;LENGTH OF THE STIING
	JSR	PC,BUILDS	;GO ALLOCATE SPACE
	ADD	#6,R1		;"POP" THE STRING
	MOV	#16.,R2		;# OF WORDS
UUO02:	MOV	(R4)+,(R3)+	;COPY A WORD
	SOB	R2,UUO02	;LOOP TILL THE JOBS DONE
	JSR	PC,@(SP)+	;POP AND RETURN
	MOV	(SP)+,R5	;GET R5 BACK 
	MOV	(SP)+,R4	;AND THE ADDRESS OF THE FIRQB
	BUFFER,RETSML		;RETURN THE BUFFER
	RTS	PC		;AND RETURN

SLEEP:	MOV	(R1)+,R0	;GET THE NUMBER
	JSR	PC,SVACRG	;PUT AWAY THE REGISTERS
	.SLEEP			;LULLABY AND GOOD NIGHT
	BR	RSACRG		;WHAT TIME IS IT?

RND:	TST	(R1)		;NO ARGS IS OK
	BEQ	RND01		;BRANCH IF NO ARGS
	JSR	R5,INTFUN	;ELSE COLLECT OURS
	ARG	FAF		;ONLY ONE NUMBER PLEASE
	ADD	#6,R1		;AND GET RID OF IT TOO
RND01:	MOV	SPDA,R4		;GET A DATA AREA POINTER
	MOV	RNDM(R4),R2	;GET THE LAST NUMBER
	MOV	#31747.,R3	;3968*8+3--MAGIC HUH?
	JSR	PC,MULTI	;UNSIGNED MULTIPLY HERE
	MOV	R3,RNDM(R4)	;SAVE THE RESULT
	BIC	#100000,R3	;CLEAR THE HIGH ORDER SIGN BIT
	MOV	#100000,-(R1)	;STORE AN EXPONENT
	MOV	R3,-(R1)	;STORE THE NUMBER
	CLR	-(R1)		;AND THEN LOW ORDER
	JMP	NORM		;AND NORMALIZE

ASCII:	JSR	R5,INTFUN	;CALL THE PDP-11 FUNCTION INTERPRETER
	ARG	FAS		;ONE STRING REQUIRED
	MOV	R1,R3		;COPY THE STACK
	ADD	PNTR(R3),R3	;POINTE THE THE STRING
	CLR	-(SP)		;POSSIBLE 0 ANSWER
	TST	LENGTH(R1)	;SEE IF NO STRING
	BEQ	ASCII1
	MOVB	(R3)+,(SP)	;SAVE THE BYTE
ASCII1:	JSR	PC,PSTJS	;POP THE STRING
	MOV	(SP)+,-(R1)	;SAVE THE VALUE
	JMP	FLT		;AND MAKE FLOATING
;	TABLE OF DEVICE HANDLER--IO BUFFER RELATIONS

;	IOMLN IS MAX POSITION FOR COMMA IN PRINT STMT
;	IOFLG IS INITIAL FLAG BYTE
;	SIZES IS USER BUFFER SIZE

IOMLN:	.WORD	252.		;DSK
	.WORD	70.		;TTY
	.WORD	252.		;DTA
	.WORD	70.		;LPT
	.WORD	0.		;PTR
	.WORD	126.		;PTP

SIZES:	.WORD	1000		;DSK
	.WORD	200		;TTY
	.WORD	1000		;DTA
	.WORD	200		;LPT
	.WORD	200		;PTR
	.WORD	200		;PTP

IOFLG:	.WORD	0		;DSK
	.WORD	FORCE		;TTY
	.WORD	0		;DTA
	.WORD	FORCE		;LPT
	.WORD	0		;PTR
	.WORD	FORCE		;PTP

WAITF:	MOV	SPDA,R2		;GET DATA AREA POINTER
	MOV	(R1)+,WAITTM(R2);SET THE WAIT TIME
ONERR9:	RTS	PC		;AND RETURN

ONERR:	GWTXT	R0		;GET ERROR STATEMENT HEADER
	MOV	SPDA,R2		;GET DATA AREA POINTER
	MOV	R0,OEGTLN(R2)	;STORE FOR ERROR TIME
	BNE	ONERR9		;BRANCH IF NON ZERO
	CMP	ST,#PR0!Z	;SEE IF HANDLING AN ERROR
	BNE	ONERR9		;EXIT IF NOT AT THE ERROR LEVEL
	MOV	RESLOC(R2),R3	;GET OLD SCTH
	ADD	SPTA,R3		;MAKE IT ABSOLUTE
	MOV	R3,SCTH		;AND STUFF IT INTO SCTH
	MOV	#TRAP!FATAL,-(SP)	;STORE A TRAP VALUE
	BISB	ERRVAL(R2),(SP)	;ADD THE ERROR COUNT
	MOV	SP,PC		;WOW
RANDOM:	MOV	SPDA,R4		;GET A DATA AREA POINTER
	ADD	TIMSEC,RNDM(R4)	;MAKE A NEET NUMBER
	BIS	#1,RNDM(R4)	;MAKE IT ODD
	RTS	PC		;AND RETURN

INTFUN:	MOV	(R5)+,R0	;GET SPECIFIED FUNCTION PATTERN
DEFFUN:	MOV	(R1)+,R2	;GET THE INVOCATION PATTERN
	CMP	R2,R0		;DO A QUICK LOOK SEE
	BEQ	FUNC98		;EXIT NOW IF ALL OK
	MOV	SPDA,R4		;GET A POINTER TO THE DATA AREA
	MOV	R5,-(SP)	;SAVE THE IPC, WE AREN'T MOVING
	CLR	R5		;WE'LL USE R5 TO COUNT THE # OF PARMS
FUNC01:	CLR	R3		;R3 BECOMES THE TYPE INDEX
	ROR	R2		;GET A BIT
	ROL	R3		;STORE IT IN THE REGISTER
	ROR	R2		;GET THE SECOND BIT
	ROL	R3		;THIS IS COMPLEMENT OBVERSE
	INC	R5		;TALLY A PARM
	ASL	R3		;MAKE INTO A BRANCH OFFSET
	ADD	R3,PC		;DISPATCH ON TYPE,000-END,010-FIXED,100-FLOATING,110-STRING
	BR	FUNC16		;POP THEM OFF NOW
	BR	FUNC02		;BRANCH IF FIXED
	BR	FUNC03		;BRANCH IF FLOATING
	ADD	R1,(R1)		;MAKE LINK ABSOLUTE
	SUB	R4,(R1)		;MAKE IT RELATIVE TO SPDA
	MOV	(R1)+,(R4)	;MOVE IT OFF THE PLIST TEMPORARILY
	ADD	R1,(R1)		;MAKE POINTER ABSOLUTE ALSO-OFF BY TWO
	MOV	(R1)+,-(SP)	;STORE THE POINTER
	MOV	(R1)+,-(SP)	;AND THE LENGTH ALSO
	MOV	#4,-(SP)	;AND TYPE IT;4=STRING
	BR	FUNC01		;AND LOOP FOR MORE

FUNC02:	MOV	(R1)+,-(SP)	;SAVE THE INTEGER
	CLR	-(SP)		;TYPE IT;0=FIXED
	BR	FUNC01		;AND GO GET MORE GOODIES

FUNC03:	MOV	(R1)+,-(SP)	;POP AND SAVE
	MOV	(R1)+,-(SP)	;  ALL THREE WORDS
	MOV	(R1)+,-(SP)	;    OF A FLOATING PT. NUMBER
	MOV	#2,-(SP)	;TYPE IT;2=FLOATING
	BR	FUNC01		;ADVANCE TO GO LOOP AGAIN

FUNC14:	ASL	R0		;MOVE THE WANTED LIST OVER 
	ASL	R0		;  OVER TWO BITS FOR THE POP OFF
	BEQ	FUNC13		;BRANCH IF AN ERROR--TO GET HERE R3<>0
FUNC16:	BIT	#140000,R0	;SEE IF DONE YET
	BEQ	FUNC14		;LOOP IF MORE TO DO
FUNC04:	CLR	R3		;TYPE TO BE
	ROL	R0		;GET A BIT OF THE WANTED
	ROL	R3		;MOVE IT TO THE INDEX AREA
	ROL	R0		;GET A SECOND BIT
	ROL	R3		;MAKE COMPLEMENT OBVERSE INDEX
	ASL	R3		;MAKE AN INDEX WORD 
	DEC	R5		;TOGGLE THE PARM COUNTER
	BLE	FUNC15		;BRANCH IF DONE
	ADD	R3,PC		;DISPATCH ON NEW TYPE
	BR	FUNC13		;TO GET HERE IS TO ERR
	BR	FUNC08		;BRANCH IF FLOAT WANTED
	BR	FUNC05		;BRANCH IF FIXED WANTED
	ADD	(SP)+,PC	;DISPATCH ON STACK TYPE
	BR	FUNC13		;OH BOY AN ERROR
	BR	FUNC13		;OH BOY AN ERROR
	MOV	(SP)+,-(R1)	;STACK THE LENGTH
	MOV	(SP)+,-(R1)	;MOVE THE POINTER
	SUB	R1,(R1)		;REMEMBER HOW SLOPPY WE WERE STOREING IT?
	MOV	(R4),-(R1)	;SET FORMER FIRST STRING
	ADD	R4,(R1)		;MAKE ABSOLUTE
	SUB	R1,(R1)		;MAKE A LINK FROM HERE
	MOV	R1,(R4)		;SET UP NEW FIRST POINTER
	SUB	R4,(R4)		;MAKE RELATIVE OT SPDA
	BR	FUNC04		;GO FINISH THE JOB

FUNC05:	ADD	(SP)+,PC	;SEE SHAT IS THERE
	BR	FUNC06		;ALL OK JUST COPY IT
	BR	FUNC07		;MUST FIX IT FIRST
	BR	FUNC13		;HE MADE A MISTAKE

FUNC06:	MOV	(SP)+,-(R1)	;PUT IT BACK SILLY
	BR	FUNC04		;LOOP FOR MORE

FUNC07:	MOV	(SP)+,-(R1)	;MOVE THE FLOATING
	MOV	(SP)+,-(R1)	;  POINT NUMBER BACK
	MOV	(SP)+,-(R1)	;    TO THE STACK
	JSR	PC,FIX		;FIX IT
	BR	FUNC04		;LOOP AGAIN

FUNC08:	ADD	(SP)+,PC	;DISPATCH ON STORED TYPE
	BR	FUNC10		;BRANCH IF FLT NEEDED
	BR	FUNC09		;BRANCH IF STRAIGHT COPY
	BR	FUNC13		;BRANCH IF AN ERROR

FUNC09:	MOV	(SP)+,-(R1)	;MOVE THE NUMBER
	MOV	(SP)+,-(R1)	;  BACK TO THE 
	MOV	(SP)+,-(R1)	;    STACK WHERE IT BELONGS
	BR	FUNC04		;LOOP FOR MORE

FUNC10:	MOV	(SP)+,-(R1)	;COPY THE INTEGER
	JSR	PC,FLT		;MAKE A MAN OUT OF HIM
	BR	FUNC04		;LOOP TO FINISH MAYBE

FUNC13:	FUNERR	!FATAL

FUNC15:	MOV	(SP)+,R5	;RESTORE THE IPC
	TST	R3		;SEE IF THE RIGHT NUMBER OF THEM
	BNE	FUNC13		;MUST BE ZERO ELSE AN ERROR
FUNC98:	RTS	R5		;AND BACK WE GO
MULI:	CLR	R0		;SIGN MANAGEMENT WORD
	MOV	(R1)+,R2	;GET NUMBER 1
	BEQ	MULI00		;QUICK ON ZERO
	BPL	MULI01		;BRANCH IF PLUS
	COM	R0		;TOGGLE THE SIGN
	NEG	R2		;MAKE POSITIVE
MULI01:	MOV	(R1)+,R3	;GET NUMBER 2
	BEQ	MULIO0		;FAST IF ZERO
	BPL	MULI02		;BRANCH IF PLUS
	COM	R0		;COMPLEMENT SIGN TOGGLE
	NEG	R3		;MAKE POSITIVE VILLE
MULI02:	JSR	PC,MULTI	;MULTIPLY THE NUMBERS
	TST	R0		;SEE IF POSITIVE OR NEGITIVE
	BPL	MULI03		;BRANCH IF OK AS IS
	NEG	R2		;THIS THREE
	NEG	R3		;  WORD CODE SEQUENCE IS
	SBC	R2		;    DOUBLE PREC. NEGATE
MULI03:	MOV	R3,-(R1)	;STORE THE RESULST
	RTS	PC

MULI00:	TST	(R1)+		;REMOVE OTHER NUMBER
MULIO0:	CLR	-(R1)		;STORE ANSWER WHICH IS ZERO
	RTS	PC		;AND RETURN

MULTI:	MOV	R4,-(SP)	;SAVE THE REG WE USE
	CLR	R4		;CLEAR NEW HIGH ORDER
	MOV	#21,-(SP)	;SET UP A COUNTER
MULTI1:	ROR	R4		;SHIFT THE PPRODUCT
	ROR	R3		;  RIGHT ONE BIT
	BCC	MULTI2		;BRANCH IF NO MORE WORK THIS TRIP
	ADD	R2,R4		;ADD IN FACTOR
MULTI2:	SOB	(SP),MULTI1	;LOOP IF MORE TO DO
	TST	(SP)+		;POP COUNTER
	MOV	R4,R2		;COPY HIGH ORDER
	MOV	(SP)+,R4	;RESTORE R4
	RTS	PC		;AND RETURN

RDIVI:	MOV	(R1)+,R2	;GET DIVIDEND
	MOV	(R1)+,R3	;GET THE DIVISOR
	MOV	R2,-(R1)	;START THE REVERSE 
	MOV	R3,-(R1)	;  ORDER STORE STUFF

DIVI:	MOV	R5,-(SP)	;SAVE THE IPC
	CLR	-(SP)		;SET UP A SIGN CONTROL WORD
	MOV	(R1)+,R4	;PICK UP THE DIVISOR
	BEQ	DIVIV		;DIVISION BY ZERO IS A NO-NO
	BGT	DIVI7		;CHECK THE SIGN
	INC	(SP)		;AND KEEP TRACK AS ABOVE
	NEG	R4	
DIVI7:	CLR	R2		;CLEAR THE HIGH ORDER
	MOV	(R1)+,R3	;PICK UP THE DIVIDEND
	BGE	DIVI8		;CHECK THE SIGN
	DECB	1(SP)		;KEEP TRACK OF THE ORIGINAL
	NEG	R3		;THE ORIGINAL NUMBER
DIVI8:	MOV	R4,R5		;MOVE THE DIVISOR AND
	NEG	R5		;NEGATE FOR THE ALGORITHM
	ADD	R5,R2		;PREFORM THE INITIAL SUBTRACTION
	MOV	#20,-(SP)	;SET UP A COUNTER
	CLR	R0		;THIS IS A LASTING CARRY BIT
DIVI1:	ROL	R3		;ROTATE ONE LEFT
	ROL	R2
	TST	R0		;CHECK THE LAST CARRY
	BEQ	DIVI2		;IF ZERO ADD ELSE SUBTRACT
	CLR	R0		;CLEAR THE CARRY
	ADD	R5,R2		;DO ONE MORE STEP
	BR	DIVI3

DIVI2:	ADD	R4,R2		;-2N+N=N FOR THIS STEP
DIVI3:	ADC	R0		;KEEP IT A WHILE
	BEQ	DIVI9		;IF ZERO OMIT UPDATE
	INC	R3		;NO CARRY POSSIBLE
DIVI9:	DEC	(SP)		;DECREMENT COUNTER
	BGT	DIVI1		;BRANCH IF MORE TO DO
	ROR	R3		;SEE ABOUT THE LAST CYCLE
	BCS	DIVI4		;OMIT CORRECTION IF ONE
	ADD	R4,R2		;CORRECT REMAINDER
	CLC
DIVI4:	ROL	R3		;REPLACE THE LAST BIT
	TST	(SP)+		;POP THE COUNTER
	TST	(SP)		;TEST FOR REMAINDER CHANGES
	BGE	DIVI6		;OMIT IF POSITVE
	NEG	R2		;NEGATE REMAINDER
	CLRB	1(SP)		;CLEAR SIGN
	DEC	(SP)		;BUT DO A GOOD JOB ON QUOTIENT
DIVI6:	TST	(SP)+		;TEST FOR QUOTIENT ADJUSTMENT
	BEQ	DIVI5		;IF ZERO NONE NEEDED
	NEG	R3		;NEGATE QUOTIENT
DIVI5:	MOV	R3,-(R1)	;THEN QUOTIENT TO STACK
	MOV	(SP)+,R5	;RESTORE THE IPC
	RTS	PC
DIVIV:	TST	(SP)+		;REMOVE SIGN WORD
	MOV	(SP)+,R5	;RESTORE THE SAVED R5
	POST,PSTDV0		;SHOW DIVISION BY 0
	RTS	PC


RAD50A:	MOV	#3,R0		;COUNT OF DIGITS
R50A01:	MOV	#40.,R4		;PUSH THE DIVISOR
	MOV	(R1)+,R3	;GET THE DIVIDEND
	CLR	R2		;CLEAR THE HIGH ORDER
	MOV	R0,-(SP)	;SAVE THE COUNTER
	MOV	#R50A06,-(SP)	;STORE RETURN ADDRESS
	MOV	R5,-(SP)	;SAVE R5
	CLR	-(SP)		;CLEAR THE SIGN WORD
	BR	DIVI8		;"JSR TO DIVI"

R50A06:	MOV	(SP)+,R0	;RESTORE THE COUNTER
	MOV	R2,-(SP)	;SAVE THE DIGITS
	SOB	R0,R50A01	;BRANCH IF MORE TO DO
	MOV	SP,R3		;R3 IS THE OUTPUT BUFFER
	MOV	SP,R2		;R2 FOLLOWS THE INPUT DIGITS
	TST	(R1)+		;POP THE FINAL ZERO
	MOV	#3,R0		;SET UP A COUNTER
R50A02:	TSTB	(R2)		;SEE IF ZERO
	BEQ	R50A05		;BRANCH IF A SPACE
	CMPB	(R2),#36	;SEE IF ALPHA OR NUMBERIC
	BGE	R50A03		;BRANCH IF NUMERIC
	ADD	#56,(R2)	;56+22=100 WHICH IS ALPHA OFFSET
R50A03:	ADD	#22,(R2)	;22 IS NUMERIC OFFSET
R50A04:	MOVB	(R2)+,(R3)+	;MOVE A BYTE
	INC	R2		;MOVE TO NEXT DIGIT
	SOB	R0,R50A02	;LOOP IF MORE TO COME
	CLRB	(R3)+		;END OF THE LINE
	MOV	SP,R2		;R2 FOR OUTPUT
	JSR	PC,PRINTL	;PRINT IT
	ADD	#6,SP		;REMOVE THE THREEE TEMP WORDS
	RTS	PC		;AND RETURN

R50A05:	MOVB	#' ,(R2)	;MOVE IN A SPACE
	BR	R50A04		;AND RESUME LIKE ALL OTHERS

TIMEF:	JSR	R5,INTFUN	;CALL FUNCTION ARBITRATOR
	ARG	FAI		;GET AN INTEGER
	MOV	(R1)+,R2	;POP IT OFF
	BNE	TIME01		;BRANCH IF NOT 0
	MOV	#100006,-(R1)	;PART OF 60.
	MOV	#074000,-(R1)	;  ANOTHER PART OF 60.
	CLR	-(R1)		;    THE LAST PART OF 60.
	MOV	#100017,-(R1)	;PART OF MINUTES FROM MIDNIGTH
	MOV	#1440.,-(R1)	;NUMBER OF MINUTES IN A DAY
	SUB	TIME,(R1)	;SEE HOW MANY LEFT
	CLR	-(R1)		;MAKE LOW ORDER EMPTY
	JSR	PC,MULF		;MAKE INTO SECONDS
	MOV	#100017,-(R1)	;LIKE BEFORE FOR INTEGERS
	MOV	#60.,-(R1)	;SECONDS IN A MINUTE
	CLR	-(R1)		;MAKE FOR A FUNNY MOVB
	MOVB	TIMSEC,(R1)	;SECONDS TILL NEXT MINUTE
	SUB	(R1)+,(R1)	;AND MAKE FROM INSTEAD OF TO
	CLR	-(R1)		;ZERO LOW ORDER
	BR	ADDF		;AND AWAY WE GO

TIME01:	DEC	R2		;SEE IF 1 OR MORE
	BNE	TIME02		;BRANCH IF 2  OR MORE
	MOV	JOBDA,R3	;JOB DATA BLOCK ADDRESS
	MOV	JDCPU(R3),-(R1)	;PUSH CPU TIME
	ADD	JOBTIM,(R1)	;AND WHAT HE'S GOT SINCE THEN
	BR	LEN11		;AND GET TO FLOAT

TIME02:	MOV	@JOBDA,R4	;GET JOB I/O BLOCK
	MOV	(R4),R4		;GET CONSOLE DDB
	MOV	DDTIME(R4),-(R1);PUSH THE CONNNECT TIME
	SUB	TIME,(R1)	;SEE HOW LONG HE'S BEEN WITH US
	BGE	LEN11		;IF NEGATIVE, FUDGE FOR YESTERDAY LOGIN
	ADD	#1440.,(R1)	;LATE AT NIGHT--MUST BE A PROGRAMMER
	BR	LEN11		;AND FINISH THRU FLT
LEN:	JSR	R5,INTFUN	;GO DO FUNCTION MANAGEMENT
	ARG	FAS		;ONE STRING WANTED
	JSR	PC,PSTJS	;POP THE STRING
	TST	-(R1)		;GET BACK THE LENGTH
LEN11:	BR	FLT		;GET LENGTH AND FLOAT IT

FIXF:	JSR	R5,INTFUN	;CALL COMMON FUNCTION CODER
	ARG	FAF		;ONE FLOATING NUMBER
	MOV	2(R1),-(SP)	;SAVE THE SIGN
	JSR	PC,ABSF00	;GET ABSOLUTE NUMBER
	JSR	PC,INTF00	;MAKE INTO AN INTEGER
	TST	(SP)+		;SEE IF NEGATIVE BEFOER
	BMI	NEGF		;NEGATE IF MINUS (& RETURN THRU NEGF)
	RTS	PC		;RETURN 


PEEKF:	JSR	R5,INTFUN	;GET ARG TO BE FIXED
	ARG	FAI
	BIC	#100001,(R1)	;CLEAR HIGH AND LOW BITS TO BE SURE
	MOV	@(R1)+,-(R1)	;PICK UP THE CONTENTS
	BR	LEN11		;AND FLOAT AND EXIT
ADDF:	MOV	R5,-(SP)	;SAVE THE IPC
	CMP	12(R1),4(R1)	;SEE IF A SWAP IS NEEDED
	BHIS	ADDF1		;WE'D LIKE THE LOWER EXPONENT ON THE SP STACK
	ADD	#6,R1
	MOV	R1,R4
	MOV	(R1)+,R3
	MOV	(R1)+,R2	;MOVE THE LOWER EXPONENT TO THE STACK
	MOV	(R1)+,R0
	MOV	-(R4),-(R1)
	MOV	-(R4),-(R1)	;COLLAPSE THE USER STACK
	MOV	-(R4),-(R1)
	BR	ADDF2

ADDF1:	MOV	(R1)+,R3
	MOV	(R1)+,R2	;TO THE STACK BACKWARDS WE GO
	MOV	(R1)+,R0	;EXPONENT TO R0
ADDF2:	CLR	R4
	CLR	R5		;CLEAR THE SUPPER LOW
	SUB	4(R1),R0	;CALCULATE THE # OF SHIFTS
	BEQ	ADDF5		;BRANCH IF NO ADJUSTMENT NEEDED
	BPL	NORM5		;POST NORMALIZE IF NEEDED
	CMP	R0,#-37
	BLT	NORM5		;BRANCH IF NO ADD POSSIBLE

;	NON-EAE CODE
F.AF1:	ASR	R2
	ROR	R3		;SUPER SHIFT
	ROR	R4
	ROR	R5
	INC	R0		;INCREMENT COUNTER
	BLT	F.AF1		;BRANCH IF MORE TO DO
;	END OF NON-EAE CODE

ADDF5:	ADD	(R1)+,R3
	ADC	R2		;ADD LOW ORDER FRACTION
	BVS	ADDF3		;BRANCH IF FUNNY NUMBER
	ADD	(R1)+,R2
	BVC	NORM1		;IF CLEAR POST-NORMALIZE WITH ROUNDING
ADDF4:	ROR	R2
	ROR	R3
	ROR	R4		;NO BITS BEYOND R4 ARE NEEDED
	INC	(R1)		;ADJUST THE EXPONENT
	BNE	NORM1		;BRANCH IF ALL OK
	POST,PSTFLT		;ELSE GIVE ERROR
	BR	NORM4		;ERROR

ADDF3:	ADD	(R1)+,R2	;R2 BEFORE THE ADD WAS 100000
	BCS	NORM1		;FURTHER THE EXPONENTS ARE EQUAL
	BR	ADDF4

SUBF:	NEG	2(R1)		;SUBTRACT IS NEGATE AND ADD
	NEG	(R1)
	SBC	2(R1)
	BR	ADDF		;GO BABY GO

RSUBF:	NEG	10(R1)		;REVERSE SUBTRACT IS SIMILAR
	NEG	6(R1)
	SBC	10(R1)
	BR	ADDF		;SEE WHAT I MEAN

ABSF:	JSR	R5,INTFUN	;ADJUST THE ARGUMENTS
	ARG	FAF		;FLOATING (1) WANTED
ABSF00:	TST	2(R1)		;TEST FOR NEGATIVE
	BGE	NEGF1		;EXIT NOW IF POSITIVE
NEGF:	NEG	2(R1)		;GEE NEGF IS KINDA LIKE SUBF
	NEG	(R1)
	SBC	2(R1)
NEGF1:	RTS	PC		;AND RETURN

FLT1:	MOV	(R1)+,-(SP)	;MOVE THE FLOATING 
	MOV	(R1)+,-(SP)	;  POINT NUMBER FROM THE USER
	MOV	(R1)+,-(SP)	;    STACK TO THE SYSTEM STACK
	JSR	PC,FLT		;FLOAT THE INTEGER BELOW IT
	MOV	(SP)+,-(R1)	;NOW MOVE IT
	MOV	(SP)+,-(R1)	;  BACK FROM WHENCH
	MOV	(SP)+,-(R1)	;    IT CAME
	RTS	PC		;AND RETURN

ERR:	MOV	SPDA,R2		;GET SWAP AREA POINTER
	CLRB	-(R1)		;ODD BYTE IS ZERO
	MOVB	ERRVAL(R2),-(R1);STORE ERROR VALUE

FLT:	MOV	(R1),-(R1)	;MOVE THE INTEGER
	MOV	#100020,2(R1)	;STORE THE EXPONENT
	CLR	-(R1)		;CLEAR THE LOW ORDER
	ASR	2(R1)		;MOVE OVER FOR -32768 CASE
	ROR	(R1)		;AND PUT THE LOW ORDER BIT HERE

NORM:	MOV	R5,-(SP)	;SAVE THE IPC FOR LATTER
NORM5:	MOV	(R1)+,R3	;PICK UP HIGH ORDER
	MOV	(R1)+,R2	;AND THE LOW ORDER
	CLR	R4
	CLR	R5		;BOY ARE WE PRECISE!!
NORM1:	MOV	R5,R0		;SEE IF ANY BITS ARE ON(ADDF ENTERS HERE)
	BIS	R4,R0
	BIS	R3,R0
	BIS	R2,R0
	BNE	NORM2		;IF NON-ZERO GO NORMALIZE
NORM4:	CLR	(R1)
	CLR	-(R1)		;FORCE A FLOATING POINT ZERO
	CLR	-(R1)
NORM3:	MOV	(SP)+,R5	;UNSAVE THE IPC
	RTS	PC		;AND RETURN-NORMALLY
NORM2:
;	NON-EAE CODE

	MOV	#-1,R0		;DECREMENT FOR CORRECT COUNT
F.NR1:	INC	R0		;COUNT THE TIMES
	ASL	R5
	ROL	R4		;BOY OH BOY WHAT A SHIFT
	ROL	R3
	ROL	R2
	BVC	F.NR1		;LOOP IF MORE TO DO
	BNE	F.NR2
	MOV	R3,R3
	BNE	F.NR2
	SEC
	ROR	R2
	ROR	R3
	DEC	R0		;ADJUST FOR FUNNY -(2^N)
	SEC
F.NR2:	ROR	R2
	ROR	R3
	ADC	R3		;ROUND THE FRACTION
	ADC	R2
	BVC	F.NR4		;OVERFLOW IS A FUNNY ROUND
	DEC	R0
	BR	F.NR2		;GO AGIAN

F.NR4:

;	END OF NON-EAE CODE

	MOV	(R1),R4		;GET OLD EXPONENT
	SUB	R0,(R1)		;UPDATE THE EXPONTENT
	MOV	R2,-(R1)	;STORE THE HIGH ORDER
	MOV	R3,-(R1)	;STORE THE LOW ORDER
	ADD	#100000,R4	;STRIP EXPONTNE MODULUS BIT
	CMP	R4,R0		;TEST FOR SIGN CHANGE WITH SHIFT COUNT
	BVC	NORM3		;BRANCH IF NO UNDERFLOW OR OVERFLOW
	POST,PSTFLT		;POST A FLOATING ERROR
	BR	NORM3		;AND RETURN
MULF:	MOV	#33.,-(SP)	;MAIN LOOP COUNTER
	CLR	-(SP)		;SIGN MANAGEMENT WORD
	MOV	#MULF05,-(SP)	;FOR NORM1 LATTER
	MOV	R5,-(SP)	;SAVE THE IPC
	MOV	(R1)+,R5
	MOV	(R1)+,R4	;GET THE FIRST NUMBER
	BEQ	MULF0		;A POSSIBLE ZERO
	BGT	MULF01		;OMIT SIGN CHANGE IF POSITIVE
	NEG	R4
	NEG	R5		;NEGATE DOUBLE PRECISION NUMBER
	SBC	R4
	COM	4(SP)		;AND TOGGLE THE SWITCH
MULF01:	MOV	2(R1),-(SP)	;LOW ORDER #2 TO THE STACK
	MOV	4(R1),R0	;HIGH ORDER TO R0
	BEQ	MULFO0		;CHECK FOR VALID ZERO
	BGT	MULF02		;TEST SIGN CHANGE NEEDED
	NEG	R0
	NEG	(SP)		;NEGATE
	SBC	R0
	COM	6(SP)		;2 WRONGS MAKE A RIGHT IN SIGNS
MULF02:	CLR	R2
	CLR	R3		;CLEAR HIGH ORDER TO BE
MULF03:	ROR	R2
	ROR	R3
	ROR	R4		;QUAD PRECISION SHIFT
	ROR	R5
	BCC	MULF04		;SEE IF ADD NEEDED
	ADD	(SP),R3
	ADC	R2		;ADD MULTIPLIER
	ADD	R0,R2
MULF04:	DEC	10(SP)		;DECREMENT COUNTER
	BGT	MULF03		;LOOP IF MORE TO DO
	TST	(SP)+		;GET RID OF SPENT LOW ORDER
	MOV	#100000,-(R1)	;FOR NORMALIZATION COUNT
	BR	NORM1		;NORMALIZE THE FRACTION
MULF05:	MOV	(SP)+,(SP)+	;TEST AND DOUBLE POP IN ONE WORD
	BEQ	MULF06		;IF POSITIVE RESULT OMIT NEXT INSTRUCTION
	JSR	PC,NEGF		;MAKE NEGATIVE
MULF06:	MOV	(R1)+,6(R1)	;MOVE THE FRACTION TO THE RESULT AREA
	MOV	(R1)+,6(R1)	;BOTH HIGH ORDER AND LOW ORDER
	MOV	#100000,R0	;EXCESS VALUE
	MOV	(R1)+,R2	;NORMALIZATION COUNT
	MOV	(R1)+,R3	;EXPONENT #1
	MOV	4(R1),R4	;EXPONENT #2
	ADD	R0,R3		;REMOVE THE EXCESS
	ADD	R0,R4		;  FROM THE EXPONENTS
	ADD	R0,R2		;    DO DO PDP-11 STYLE ARITHMETIC
	INC	R2		;15*15=30 BUT NORMALIZE THINKS ABOUT 31
	ADD	R2,R3		;SEE HOW THIS WORKS
	BVS	MULF08		;COULD BE THIN ICE
	ADD	R4,R3		;FINISH UP
	BVS	MULF09		;IS DEFINATELY NO ICE HERE-OVERFLOW!
MULF07:	ADD	R0,R3		;CONVERT TO EXCESS FORM
	MOV	R3,4(R1)	;STORE THE NEW EXPONENT
	RTS	PC
MULF08:	ADD	R4,R3		;COULD BE OK AFTER THIS
	BVS	MULF07		;JUST AN UNFOUNDED RUMOR
	CLR	4(R1)		;UNDERFLOW
	BR	MULF10

MULF09:	MOV	#177777,4(R1)	;OVERFLOW
MULF10:	POST,PSTFLT		;SET THE ERROR BIT
	RTS	PC		;AND EXIT

MULFO0:	TST	(SP)		;SEE IF REALLY ZERO
	BNE	MULF02		;BRANCH FI MULT NEEDED
	TST	(SP)+		;CLEAN UP THE STACK
	BR	MULF11

MULF0:	TST	R5		;TEST LOW ORDER
	BNE	MULF01		;BRANCH IF A NUMBER
MULF11:	ADD	#10,R1		;REMOVE ALL NUMBERS
	CLR	-(R1)
	CLR	-(R1)		;STORE ZERO
	CLR	-(R1)
	MOV	(SP)+,R5	;RESTORE THE IPC
	ADD	#6,SP		;CLEAN UP THE SP STACK NOW
	RTS	PC

CMPF:	MOV	(R1)+,R3	;LOF
	MOV	(R1)+,R2	;HOF
	MOV	(R1)+,R0	;EXPONENT
	MOV	#077777,-(SP)	;POS # AND THE NEEDED MASK
	MOV	R2,R4
	BIC	(SP),R4
	ADD	2(R1),R4	;CHECK FOR SAME SIGN
	BPL	CMPF01
	TST	R2		;DIFFERENT SIGNS HENCE RESULT = SRC
	BPL	CMPF21		;IF + OR ZERO
	BR	CMPF20		;IF -

CMPF01:	MOV	4(R1),R4	;THE OTHER EXPONENT
	BCC	CMPF02
	COM	R0
	COM	R4
CMPF02:	CMP	R0,R4	
	BHI	CMPF21		;SIGNS ARE THE SAME
	BLO	CMPF20
	CMP	R2,2(R1)	;CHECK HOF
	BGT	CMPF21
	BLT	CMPF20
	CMP	R3,(R1)		;CHECK LOF
	BHI	CMPF21
	BLO	CMPF20
	CLR	(SP)		;MAKE POP NUMBER 0
	BR	CMPF20		;AND EXIT THRU CMPF20
CMPF21:	COM	(SP)		;POP OF A NEGATIVE NUMBER
CMPF20:	TST	(SP)+		;POP THE RESULT FLAG
	RTS	PC		;AND RETURN

INTF:	JSR	R5,INTFUN	;CALL THE COMMON FUNCTION DUDE
	ARG	FAF
INTF00:	MOV	4(R1),R4	;EXPONENT
	BPL	INTF09		;BRANCH IF SPECIAL
	CMP	R4,#100037	;CHECK TO SEE IF ANTHEIN NEEDED
	BHIS	INTF08		;EXIT NOW IF BIG NUMBER
	CLR	R2
	CLR	R3		;CLEAR THE MASK
	ADD	#100000,R4	;CONVERT TO REAL NUMBER
	BEQ	INTF09		;EXP OF 0 IS SPECIAL
	ADD	#-37,R4		;COMPUTE FRACTIONAL PART
INTF01:	SEC			;SET CARRY FOR MASK ROTATE
	ROL	R3		;SHIFT IN A 1 BIT
	ROL	R2
	INC	R4		;BUMP COUNTER
	BLT	INTF01		;LOOP IF MORE TO DO
	BIC	R2,2(R1)	;CLEAR FRACTIONAL BITS
	BIC	R3,(R1)
	BNE	INTF08		;BRANCH IF NOT THE SPECIAL CASE
	CMP	#100000,2(R1)	;SEE IF WE CLOBERED THE HI FRACTION
	BNE	INTF08		;BRANCH IF OK
	MOV	#140000,2(R1)	;REPLACE WITH THE SPECIAL FRACTION
INTF08:	RTS	PC

INTF09:	CLR	(R1)		;BOTH START LO = 0
	TST	2(R1)		;SEE IF + OR -
	BPL	INTF0O		;IF 0 OR + THEN 0
	MOV	#140000,2(R1)
	MOV	#100001,4(R1)	;STORE -1
	RTS	PC

INTF0O:	CLR	2(R1)
	CLR	4(R1)		;STORE A 0
	RTS	PC

;SIGN FUNCTION ROUTINE

SGNF:	JSR	R5,INTFUN	;CALL THE FUNCTION FIXER UPPER
	ARG	FAF		;ONE FLOATER
	TST	(R1)+		;POP LOW ORDER FRACTAON
	MOV	(R1)+,(R1)+	;TEST HIGH ORDER AND POP IT AND EXPONENT
	BEQ	PUSHF0		;BRANCH TO GET ZERO RESULT
	BPL	PUSHF1		;BRANCH FOR +1
	MOV	#100001,-(R1)	;PUSH A -1. -- EXPONENT
	MOV	#140000,-(R1)	;HIGH ORDER FRACTION
	BR	PUSHR1		;PUSH AN INTEGER 0

;	PUSHFX ROUTINE

PUSHFX:	MOV	#100004,-(R1)	;EXPONENT OF TEN
	MOV	#050000,-(R1)	;HIGH ORDER FRACTION
	BR	PUSHR1		;PUSH 0

;	PUSHF0 ROUTINE

PUSHF0:	CLR	-(R1)
	CLR	-(R1)
	BR	PUSHR1		;PUSH LAST 0 WORD

;	PUSHF1 ROUTINE

PUSHF1:	MOV	#100001,-(R1)
	MOV	#040000,-(R1)	;STRE A 1.
PUSHR1:	CLR	-(R1)
	RTS	PC

;	REPF ROUTINE

REPLF:	GWTXT	R0
	ADD	SPDA,R0		;COMPUTE THE REAL ADDRESS
	MOV	(R1)+,(R0)+
	MOV	(R1)+,(R0)+	;MOVE THE NUMBER
	MOV	(R1)+,(R0)+
	SUB	#6,R1
	RTS	PC

ATOI:	CLR	R3		;CLEAR THE NUMBER TO BE
	CLR	R4		;AND THE SWITCHES
ATOI01:	MOVB	(R2)+,R0	;GET A CHARACTER
	BIC	#177600,R0	;REMOVE PARITY BIT AND SIDE EFFECT
	SUB	#'0,R0		;REDUCE TO BINARY IF A NUMBER
	BLT	ATOI10		;BRANCH IF + OR - (OR OTHER SPECIAL ONE)
	CMPB	R0,#'9-'0	;SEE IF OUT OF RANGE HIGH
	BGT	ATOI10		;BRANCH IF NON-NUMERIC
	BITB	R4,#4		;SEE IF - SWITCH
	BEQ	ATOI02		;BRANCH IF + NUMBER
	NEG	R0		;NEGATE CURRENT DIGIT
ATOI02:	ASL	R3		;N*2
	BVS	ATOI91		;OVERFLOW CHECK
	MOV	R3,-(SP)	;SAVE FOR LATTER
	ASL	R3		;N*4
	BVS	ATOI90		;OVERFLOW CHECK
	ASL	R3		;N*8
	BVS	ATOI90		;OVERFLOW CHECK
	ADD	(SP)+,R3	;N*8+N*2=N*10
	BVS	ATOI91		;OVERFLOW CHECK
	ADD	R0,R3		;INCLUDE THE CURRENT DIGIT
	BVS	ATOI91		;AND A FINAL OVERFLOW CHECK
	BISB	#1,R4		;SET NUMBERS SEEN
	BR	ATOI01		;AND RESUME THE SCAN

ATOI10:	CMPB	R0,#'	-'0	;CHECK CHARACTER FOR <TAB>
	BEQ	ATOI01		;BRANCH TO IGNORE TAB'S
	CMPB	R0,#' -'0	;CHECK CHARACTER FOR <SP>
	BEQ	ATOI01		;BRANCH TO IGNORE SP'S
	CMPB	R0,#015-'0	;SEE IF CARRIAGE RETURN
	BEQ	ATOI01		;IGNORE LIKE SPACES
	CMPB	R0,#'+-'0	;CHECK CHARACTER FOR <+>
	BEQ	ATOI20		;BRANCH IF A + SIGN
	CMPB	R0,#'--'0	;CHECK CHARACTER FOR <->
	BNE	ATOI92		;EXIT IF NOT RECIGNIZED
	BISB	#4,R4		;SET - NUMBER FOR SCANNER ABOVE
ATOI20:	BITB	R4,#3		;SEE IF SIGN IS LEGAL, I.E. ONLY ONE - NO #'S
	BNE	ATOI92		;BRANCH IF END OF THE LINE
	BISB	#2,R4		;SET SIGN ENCOUNTERED
	BR	ATOI01		;RESUME THE SCAN

ATOI90:	TST	(SP)+		;REMOVE TEMP SAVED VALUE
ATOI91:	BISB	#200,R4		;SET V SWITCH
ATOI92:	DEC	R2		;BACK UP TO BAD CHARACTER
	MOV	R3,-(R1)	;STORE THE VALUE
	ASLB	R4		;SET V + C ACCORDINGLY
	RTS	PC		;AND RETURN

FIX:	TST	(R1)+		;ANY ONE WANT THE LOW ORDER BITS?
	MOV	(R1)+,R2	;PICK UP THE WORD WHICH NEEDS SHIFTING
	MOV	(R1)+,R3	;GET THE EXPONENT
	CMP	R3,#100017	;SEE HOW THE EXPONENT IS
	BHI	FIX20		;BRANCH IF BAD NEWS TOO BIG
	BEQ	FIX10		;EXIT NOW IF DONE
	SUB	#100017,R3	;CONVERT TO A SHIFT COUNT
	BPL	FIX30		;BRANCH IF REAL SMALL
FIX01:	ASR	R2		;SHIFT RIGHT ON BIT
	INC	R3		;ADJUST THE COUNT
	BLT	FIX01		;LOOP IF NOT COMPLETELY DONE
FIX10:	MOV	R2,-(R1)	;STORE AWAY THE ANSWER
	RTS	PC		;AND RETURN

FIX20:	POST,PSTFIX		;SLOW THE ERROR

PUSHI0:	CLR	-(R1)		;GIVE ZERO - IT'S EASIEST
	RTS	PC		;AND RETURN

FIX30:	TST	R2		;SEE IF ANSWER IS 0 OR -1
	BPL	PUSHI0		;BRANCH TO PUSH A ZERO
	MOV	#-1,-(R1)	;PUSH MINUS ONE
	RTS	PC		;AND RETURN

ATOF:	CLR	-(R1)
	CLR	-(R1)		;SET NUMBER TO BE TO ZERO
	CLR	-(R1)
	CLR	-(SP)		;EXPONENT FROM . PART
	CLR	-(SP)		;EXPONENT FROM E PART
	CLR	-(SP)		;SWITCHES  ,-F,*,A,D,E,*,S IN A BYTE
ATOF01:	MOVB	(R2)+,R3	;GET A CHARACTER
	BIC	#177600,R3	;CLEAR PARITY AND SIDE EFFECT
	CMPB	R3,#'0		;COMPARE IT WITH ASCII 0
	BLT	ATOF05		;IF LESS THAN ZERO CHECK SPECIAL CHARACTERS
	CMPB	R3,#'9		;COMPARE WITH ASCII 9
	BGT	ATOF05		;IF GREATER THAN NINE CHECK FOR OTHERS
	SUB	#'0,R3		;CONVERT TO BINARY
	MOV	R2,-(SP)	;SAVE THE INPUT POINTER
	MOV	R3,-(SP)	;SAVE THE NUMBER
	JSR	PC,PUSHFX	;PUSH A FLOATING 10
	JSR	PC,MULF		;MULTIPLY BY 10.
	MOV	#100017,-(R1)	;STORE AN EXPONENT
	MOV	(SP)+,-(R1)	;STORE THE HIGH ORDER
	CLR	-(R1)		;AND LOW ORDER ZEROS
	JSR	PC,ADDF		;ADN ADD THE CURRENT DIGIT
	BITB	#10,2(SP)	;TEST D SWITCH
	BEQ	ATOF02		;IF OFF OMIT NEXT INSTRUCTION
	DEC	6(SP)		;COUNT THE NUMBER OF DECIMAL PLACES
ATOF02:	MOV	(SP)+,R2	;RESTORE THE INPUT POINTER
	BISB	#1,(SP)		;SET SIGNIFICANCE
	BR	ATOF01		;GET NEXT CHARACTER

ATOF05:	CMPB	R3,#' 		;SEE IF A <SP>
	BEQ	ATOF01		;IGNORE SPACES
	CMPB	R3,#011		;SEE IF A <TAB>
	BEQ	ATOF01		;IGNORE TABS
	CMPB	R3,#015		;SEE IF A <CR>
	BEQ	ATOF01		;IGNORE CRS
	CMPB	R3,#'.		;COMPARE WITH DECIMAL POINT
	BEQ	ATOF10		;GO ON POINT
	CMPB	R3,#'-		;COMPARE WITH MINUS SIGN
	BEQ	ATOF06		;BRANCH IF A - SIGN
	CMPB	R3,#'E		;COMPARE WITH AN "E"
	BEQ	ATOF11		;BRANCH IF AN "E"
	CMPB	R3,#'+		;COMPARE WITH A PLUS SIGN
	BNE	ATOF12		;IF NOT SPECIAL THEN QUIT THE SCAN
	CLC			;SHOW A + SIGN
	BR	ATOF07		;HANDLE LIKE -

ATOF06:	SEC			;SET - SIGN SEEN
ATOF07:	BITB	#4,(SP)		;SEE IF TO THE LEFT OR RIGTH OF AN "E"
	BNE	ATOF08		;BRANCH IF ON AN EXPONENT
	BITB	#31,(SP)	;NO NUMBERS(S),SIGNS(A), OR DECIMAL PT(D)
	BNE	ATOF12		;FI ANY ARE ON THAT'S AND ERROR
	BISB	#20,(SP)	;SET THE A SWITCH
	BCC	ATOF01		;IF + THEN NEXT CHARACTER PLEASE
	BISB	#100,(SP)	;MINUS FRACTION BIT 
	BR	ATOF01		;GO GET MORE

ATOF08:	BITB	#41,(SP)	;NO NUMBERS(S) OR SIGNS(B)
	BNE	ATOF12		;EXIT IF ERROR
	BISB	#40,(SP)	;SET B SIGN BIT
	BCC	ATOF01		;NEXT CHARACTER IF +
	BISB	#200,(SP)	;SHOW MINUS EXPONENT
	BR	ATOF01		;MORE TO COME

ATOF10:	BITB	#14,(SP)	;NO DECIMAL PTS(D) OF E'S
	BNE	ATOF12		;BRANCH IF ERROR
	BISB	#10,(SP)	;SHOW DECIMAL PT FOUND
	BR	ATOF01		;COULD BE MORE TO COME

ATOF11:	BITB	#4,(SP)		;SEE IF ANY E'S BEFORE THIS ONE
	BNE	ATOF12		;TWO'S A CROWD
	BITB	#1,(SP)		;SEE IF ANY NUMBERS TYPED
	BEQ	ATOF12		;NO NUMBERS NO DICE
	BISB	#4,(SP)		;SHOW E FOUND
	JSR	PC,ATOI		;GO COLLECT THE EXPONENT
	BVS	ATOF21		;BRANCH IF TWO SIGNS OR TOO BIG
	BIT	#2,R4		;SEE IF ANY #'S TYPED
	BEQ	ATOF21		;BRANCH IF NO EXPONENT
	MOV	(R1)+,2(SP)	;STORE THE EXPONENT AWAY
	BR	ATOF22		;EXIT CAUSE THIS IS THE END
ATOF21:	BIC	#1,(SP)		;CLEAR THE SIG FLAG CAUSE ITS AN ERROR
	MOV	(R1)+,2(SP)	;STORE A PARTIAL EXPONENT
	BIS	#100000,(SP)	;SET V BIT
ATOF22:	INC	R2		;POP CHARACTER POINTER TO FIX ATOI EXIT
ATOF12:	MOV	(SP)+,R4	;GET THE SWITCHES
	BEQ	ATOF14		;IF NOTHING THE ANS=0.
	BITB	R4,#1		;IF ANY SWITCHES THEN S SHOULD BE ON
	BEQ	ATOF13		;IF NOT ERROR
	BITB	R4,#100		;SEE IF MINUS FRACTION
	BEQ	ATOF14		;IF POSITIVE OMIT NEXT STEP
	JSR	PC,NEGF		;MAKE NEGATIVE
ATOF14:	ADD	(SP)+,(SP)	;COMBINE DECIMAL PLACES WITH EXPONENT
	BEQ	ATOF16		;EXIT IF NO ADJUSTMENT
	BVS	ATOF17		;ERROR IF TOO BIG
	BGT	ATOF18		;BRANCH IF POSITIVE EXPONENT
	MOV	#ATOFTB-6,R0	;NEGATIVE POWERS OF 10
	NEG	(SP)		;MAKE EXPONENT POSITIVE
	BR	ATOF19		;MAKE LIKE POSITVESVILLE

ATOF18:	MOV	#ATOFTA-6,R0	;POSITIVE POWERS OF 10
ATOF19:	CMP	(SP),#9900.	;AN UNREALISTIC UPPER LIMIT
	BHI	ATOF17		;BRANCH IF OUT OF RANGE
ATOF20:	TST	(SP)		;SEE IF ANY BITS ARE LEFT
	BEQ	ATOF16		;EXIT IF DONE
	ADD	#6,R0		;GO TO NEXT ELEMENT
	ASR	(SP)		;GET THE LOW ORDER BIT
	BCC	ATOF20		;IF NOT SET DON'T MULTIPLY
	JSR	PC,PUSHF2	;PUSH THE TABLE VALUE
	MOV	R0,-(SP)	;SAVE THE POINTER
	MOV	R2,-(SP)	;SAVE THE INPUT POINTER
	MOV	R4,-(SP)	;SAVE THE SWITCHES
	JSR	PC,MULF		;MULTIPLY
	MOV	(SP)+,R4	;RESTORE THE SWITCHES
	MOV	(SP)+,R2	;RESTORE THE INPUT POINTER
	MOV	(SP)+,R0	;GET THE POINTER BACK
	BR	ATOF20		;LOOP FOR MORE TO DO

ATOF13:	TST	(SP)+		;POP THE EXTRA WORD
ATOF17:	BIS	#100000,R4	;SIGNAL THE ERROR
ATOF16:	TST	(SP)+		;CLEAN UP THE STACK
	DEC	R2		;RETURN POINTING TO THE FIRST BAD CHARACTER
	ASL	R4		;SET V AND C AS NEEDED
	RTS	PC

;	THE FOLLOWING IS A TABLE OF POWERS OF TEN OF THE FORM
;	10^(2^N) WHERE N IS AN INTEGER

ATOFTA:	.WORD	000000,050000,100004	;10^1
	.WORD	000000,062000,100007	;10^2
	.WORD	000000,047040,100016	;10^4
ATOFTE:	.WORD	010000,057536,100033	;10^8
	.WORD	162340,043415,100066	;10^16
	.WORD	153325,047342,100153	;10^32
	.WORD	007647,060474,100325	;10^64
	.WORD	021750,044735,100652	;10^128
	.WORD	073005,052477,101523	;10^256
	.WORD	150152,070614,103245	;10^512
	.WORD	035344,062273,106512	;10^1024
	.WORD	116742,047505,115224	;10^2048
	.WORD	024600,061060,132447	;10^4096
	.WORD	150653,045521,165116	;10^8192
ATOFTC	=	.
;	THE FOLLOWING IS A TABEL OF POWERS OF TEN OF THE FORM
;	10^-(2^N) WHERE N IS AN INTEGER

ATOFTB:	.WORD	063146,063146,077775	;10^-1
	.WORD	102437,050753,077772	;10^-2
	.WORD	105654,064333,077763	;10^-4
	.WORD	035611,052746,077746	;10^-8
	.WORD	145137,071512,077713	;10^-16
	.WORD	107524,063730,077626	;10^-32
	.WORD	172422,052077,077454	;10^-64
	.WORD	021470,067350,077127	;10^-128
	.WORD	120612,060030,076256	;10^-256
	.WORD	173416,044044,074534	;10^-512
	.WORD	040470,050523,071267	;10^-1024
	.WORD	024544,063527,062555	;10^-2048
	.WORD	100770,051556,045332	;10^-4096
	.WORD	057754,066303,012663	;10^-8192
ATOFTD	=	.
;	MISCELLANEOUS CONSTANTS AND TABLES
ATOFTF:	.WORD	000000,050000,100003	;5
ATOFTG:	.WORD	035632,145000	;10000000000
	.WORD	002765,160400	;100000000
	.WORD	000230,113200	;10000000
	.WORD	000017,041100	;1000000
	.WORD	000001,103240	;100000
	.WORD	000000,023420	;10000
ATOFTH:	.WORD	000000,001750	;1000
	.WORD	000000,000144	;100
	.WORD	000000,000012	;10
ATOFTI:	.WORD	112000,073465,100036	;10^9
FTOA:	CLR	-(SP)		;SIGN CONTROL WORD
	TST	2(R1)		;SEE IF THE NUMBER NEEDS WORK DONE
	BEQ	FTOA12		;IF ZERO MAYBE??
	BPL	FTOA01		;IF POSITIVE NO WORK NEEDED
	JSR	PC,NEGF		;ELSE MAKE SURE IT'S POSITIVE
	COM	(SP)		;TOGGLE THE SIGN MANAGEMENT WORD
FTOA01:	CLR	-(SP)		;THIS WORD BECOMES THE SCALE FACTOR
	CMP	4(R1),#100000	;CHECK TO SEE IF BIG OR LITTLE
	BLOS	FTOA03		;BRANCH IF A FRACTION
	MOV	#ATOFTC-6,R0	;ADDRESS OF POWERS OF TEN TABLE
	MOV	#8192.,R2	;AND THE FIRST EXPONENT
FTOA02:	JSR	PC,PUSHF2	;PUSH THE SELECTED ITEM
	MOV	R2,-(SP)	;SAVE THE EXPONENT VALUE
	MOV	R0,-(SP)	;AND THE POINTER
	JSR	PC,CMPF		;SEE WHICH SIDE OF THE FENCE HE'S ON
	BLT	FTOA04		;BRANCH IF NO ADJUSTMENT NEEDED
	MOV	(SP),R0		;GET THE TABLE POINTER
	ADD	#ATOFTB-ATOFTA,R0	;POINT TO THE INVERSE VALUE
	JSR	PC,PUSHF2	;PUSH THE INVERSE VALUE
	JSR	PC,MULF		;MULTIPLYING BY THE INVERSE SAVES DIVIDING
	ADD	2(SP),4(SP)	;ADJUST THE SCALE FACTOR ACCORDINGLY
FTOA04:	MOV	(SP)+,R0	;GET THE POINTER BACK
	MOV	(SP)+,R2	;GET EXPONENT BACK
	SUB	#6,R0		;AND GO TO THE NEXT ENTRY
	ASR	R2		;SEE IF DONE
	BCC	FTOA02		;LOOP IF NOT QUITE DONE
	INC	(SP)		;GET A REAL GOOD ESTIMATE
	MOV	#ATOFTE,R0	;ADDRESS OF 10^8
FTOA16:	JSR	PC,PUSHF2	;PUT IT ON THE STACK
	JSR	PC,MULF		;MULTIPLY TO GET BIG INTEGER
	MOV	#ATOFTF,R0	;ADDRESS OF 5
	JSR	PC,PUSHF2	;PUT IT ON THE STACK
	JSR	PC,ADDF		;DO THE HALF ADJUSTMENT
	MOV	#100037,R2	;THE EXPONENT FOR DOUBLE PRECISION INTEGERS
	MOV	(R1)+,R4	;GET THE LOW ORDER FRACTION
	MOV	(R1)+,R3	;AND THE HIGH ORDER TOO
	SUB	(R1)+,R2	;AND CALCULATE THE SHIFT NEEDED
	BEQ	FTOA11		;BRANCH IF NONE TO BE DONE
FTOA06:	ASR	R3		;MOVE THE HIGH PART ONE BIT
	ROR	R4		;AND PUT IT IN THE LOW ORDER
	DEC	R2		;COUNT DOWN ONE
	BGT	FTOA06		;LOOP IF MORE TO DO
FTOA11:	MOV	(SP)+,-(R1)	;COPY THE SCALE FACTOR OVER
	TST	(SP)+		;SEE ABOUT THE SIGN
	BEQ	FTOA07		;BRANCH IF POSITIVE
	MOV	#026400,-(R1)	;THATS ODD BYTE='- EVEN BYTE=NULL
	BR	FTOA08		;REJOIN THE MAIN STREAM CODE

FTOA07:	CLR	-(R1)		;STORE A ZERO FOR A SIGN
FTOA08:	CLR	-(R1)		;CLEAR A
	CLR	-(R1)		;  SMALL OUTPUT
	CLR	-(R1)		;    BUFFER OF 11.
	CLR	-(R1)		;      BYTES IN LENGTH
	CLR	-(R1)
	MOV	#9.,-(SP)	;START A COUNTER
	MOV	#ATOFTG,R0	;INTEGER POWERS OF TEN STUFF
FTOA09:	MOV	#-1,R2		;QUOTIENT REGISTER
FTOA10:	INC	R2		;COUNT THE SUBTRACTIONS
	SUB	(R0),R3		;DO A DOUBLE
	SUB	2(R0),R4	;  PRECISION
	SBC	R3		;    SUBTRACTION
	BPL	FTOA10		;LOOP IF NO OVERDRAW
	ADD	(R0)+,R3	;ELSE CORRECT 
	ADD	(R0)+,R4	;THE ERROR
	ADC	R3		;WITH A DOUBLE ADD
	ADD	#'0,R2		;CONVERT TO ASCII
	MOVB	R2,(R1)+	;AND STORE IT
	DEC	(SP)		;SEE IF MORE TO DO
	BGT	FTOA09		;IF + GO AGAIN
	ADD	#'0,R4		;FINISH UP THE LAST DIGIT
	MOVB	R4,(R1)+	;AND STORE IT AWAY
	SUB	#10.,R1		;GO BACK AND KEEP IT SAFE
	TST	(SP)+		;GET RID OF THE SPENT COUNTER
	RTS	PC

FTOA12:	TST	(R1)		;SEE IF ALL ZERO
	BNE	FTOA01		;IF NOT ZERO GO BACK
	TST	(SP)+		;GET RID OF SIGN WORD
	CMP	(R1)+,(R1)+	;POP TWO OF THREE ZERO WORDS
	CLR	R3		;CLEAR THE NUMBER
	CLR	R4		;HIGH AND LOW ORDER
	BR	FTOA07		;AND GO LIKE POSITIVE

FTOA03:	MOV	#ATOFTD-6,R0	;TABLE OF NEGATIVE POWERS OF TEN
	MOV	#-8192.,R2	;AND THE STARTING EXPONENT VALUE
FTOA05:	JSR	PC,PUSHF2	;PUSH THE NUMBER
	MOV	R2,-(SP)	;SAVE THE EXPONENT
	MOV	R0,-(SP)	;AND THE  POINTER
	JSR	PC,CMPF		;DO THE COMPARE
	BGT	FTOA15		;BRANCH IF NO ADJUSTMENT
	MOV	(SP),R0		;GET THE POINTER
	ADD	#ATOFTA-ATOFTB,R0	;FIND THE INVERSE
	JSR	PC,PUSHF2	;AND PUT IT ON THE STACK
	JSR	PC,MULF		;MULTIPLY
	ADD	2(SP),4(SP)	;UPDATE THE EXPONENT
FTOA15:	MOV	(SP)+,R0	;RESTORE THE POINTER
	MOV	(SP)+,R2	;RESTORE THE CURRENT EXPONENT
	SUB	#6,R0		;GO TO THE NEXT ITEM 
	ASR	R2		;ADJUST AND CHECK FOR THE END
	BCC	FTOA05		;LOOP IF MORE TO DO
	MOV	#ATOFTI,R0	;MULTIPLYER IS 10^9 FOR HERE
	BR	FTOA16		;ELSE GO FINISH UP NIKE NORMAL
;	DIVISION UTILITY SUBROUTINE
;	R0-R1-R2-R2=DIVIDEND
;	R4-R5=DIVISOR
;	R0-R1=REMAINDER AFTER DIVISION
;	R2-R3=QUOTIENT AFTER DIVISION
;	ENTER WITH JSR	PC,M.DPID
;
MDPID:	MOV	#40,-(SP)	;COUNTER FOR DIVISION CYCLES
	MOV	R4,-(SP)	;HIGH ORDER
	MOV	R5,-(SP)	;LOW ORDER DIVISOR TO THE STACK
	NEG	2(SP)		;FORM NEGATIVE
	NEG	@SP		;VERSION OF THE DIVISOR
	SBC	2(SP)
	ADD	@SP,R1
	ADC	R0		;PERFORM THE INITIAL SUBTRACTION
	ADD	2(SP),R0
	BCS	M.DP50		;IF CARRY THEN OVERFLOW HAS OCCURRED
	CLR	-(SP)		;THIS IS A LONGER LASTING CARRY BIT
M.DP40:	ROL	R3
	ROL	R2
	ROL	R1
	ROL	R0
	TST	@SP		;TEST "CARRY" INDICATOR
	BEQ	M.DP41		;IF NO "CARRY" THEN ADD ELSE SUBTRACT
	CLR	@SP		;CLEAR UP FOR NEXT TIME
	ADD	2(SP),R1
	ADC	R0		;ADD -(DIVISOR)
	ADC	@SP	;  I	;SET "CARRY"
	ADD	4(SP),R0;<-
	BR	M.DP42
M.DP41:	ADD	R5,R1
	ADC	R0		;ADD +(DIVISOR)
	ADC	@SP	;  I	;SET "CARRY"
	ADD	R4,R0	;<-
M.DP42:	ADC	@SP		;SET "CARRY"
	TST	@SP		;TEST THE UPDATE INDICATOR
	BEQ	.+4	;->	;IF ZERO FORGET IT
	INC	R3	;  I	;NO CARRY POSSIBLE HERE
	DEC	6(SP)	;<-	;DECREMENT COUNTER
	BGT	M.DP40		;BRANCH IF MORE TO DO
	ROR	R3
	BCS	M.DP44
	ADD	R5,R1
	ADC	R0
	ADD	R4,R0
	CLC
M.DP44:	ROL	R3
	ADD	#10,SP		;ADJUST STACK BY 4 WORDS
	CLV
	RTS	PC
M.DP50:	ADD	#6,SP
	BR	M.DP51		;POST IT AND EXIT
DIVF00:	MOV	R5,-(SP)	;SAVE R5
	MOV	R0,-(SP)	;SAVE DEFA
	CLR	-(SP)		;SIGN CONTROL WORD
	MOV	(R1)+,R5	;PICK UP THE DIVISOR
	MOV	(R1)+,R4	;HIGH ORDER WORD
	TST	R4		;TEST FOR DIVISION BY ZERO
	BEQ	M.DIVV		;DIVISION BY ZERO IS A NO-NO
	BGE	.+12	;->	IF NEGATIVE
	NEG	R4	;  I	CHANGE THE SIGN
	NEG	R5	;  I	BUT STILL KEEP
	SBC	R4	;  I	TRACK OF THE ORIGINAL
	INC	@SP	;  I	SIGN ON THE STACK
	MOV	(R0)+,R3;<-
	MOV	(R0)+,R2	;PICK UP THE DIVIDEND
	BEQ	M.MUL0		;IF ZERO THEN SHORT DIVIDE
	BGT	.+12	;->	IF NEGATIVE
	NEG	R2	;  I	CHANGE THE SIGN
	NEG	R3	;  I	BUT STILL KEEP
	SBC	R2	;  I	TRACK OF THE ORIGINAL
	DEC	@SP	;  I	SIGN ON THE STACK WORD
	MOV	@R1,R1	;<-	;GET THE EXPONENTS
	NEG	R1		;AND SUBTRACT
	ADD	@R0,R1		;TO CHECK FOR OVER-UNDER-FLOW
	ROR	R1		;AND PUT IT ON THE STACK
	ROL	R1		;WHEN DONE
	BVC	M.DIVV
	ADD	#100000,R1
	MOV	R1,-(SP)
	MOV	R3,R1
	MOV	R2,R0
	CLR	R2		;SET UP TO DO THE DIVIDE
	CLR	R3
	ROR	R0
	ROR	R1
	ROR	R2
	JSR	PC,MDPID			;CALL THE DIVIDE ROUTINE
	NEG	R4		;CHANGE THE SIGN OF THE DIVISOR
	NEG	R5
	SBC	R4
	ASL	R1		;DOUBLE THE REMAINDER
	ROL	R0
	ADD	R5,R1		;ADD -(DIVISOR)
	ADC	R0
	ADD	R4,R0
	BLT	M.DIV2
	ADD	#1,R3		;ROUND UP THE RESULT
	ADC	R2
M.DIV2:	CLC
	ROR	R2
	ROR	R3
	INC	@SP
	TST	2(SP)		;CHECK SIGN  WORD
	BEQ	.+10	;->
	NEG	R2	;  I
	NEG	R3	;  I
	SBC	R2	;  I
	MOV	4(SP),R0;<-	 GET DEFA
	MOV	R3,(R0)+
	MOV	R2,(R0)+
	MOV	(SP)+,@R0
	CMP	(SP)+,(SP)+	;FIX UP THE STACK POINTER
	MOV	(SP)+,R5	;RESTORE R5
	CMP	-(R0),-(R0)	;POINT TO THE DESTINATION
	MOV	R0,R1
	BR	NORM00

M.DIVV:	CMP	(SP)+,(SP)+	;FIX UP THE STACK
	MOV	(SP)+,R5	;RESTORE R5
M.DP51:	POST,PSTFLT		;SET DIVIDE ERROR
	RTS	PC

M.MUL7:	MOV	(SP)+,R3	;WE SAVED THE DESTINATION FOR JUST SUCH A CAUSE
	MOV	R1,(R3)+
	MOV	R0,(R3)+
	MOV	R2,@R3
	MOV	(SP)+,R5
	RTS	PC
M.MUL0:	CLR	R0		;QUICK AND DIRTY
	CLR	R1
	CLR	R2
	TST	(SP)+		;GET RID OF THE SIGN CONTROL WORD
	BR	M.MUL7
;SUBROUTINE TO NORMALIZE AN UN-NORMALIZED FLOATING POINT NUMBER
;
NORM00:	MOV	(R1)+,R4	;MOVE SOURCE TO REGISTERS
	MOV	(R1)+,R2
	MOV	(R1)+,R3
	MOV	R3,R1		;SAVE FOR LATER CHECK
	TST	R2		;CHECK FOR A ZERO FRACTION
	BNE	M.NOR2
	TST	R4
	BNE	M.NOR2
	CLR	R3		;RETURN 0.0 CAUSE FRACTION=0
	BR	M.RET2
M.NOR2:	INC	R3
M.NORL:	DEC	R3		;NORMR4IZATION LOOP
	ASL	R4		;SHIFT FRACTION LEFT
	ROL	R2
	BVC	M.NORL		;NORMR4IZED YET?
	BCC	M.NOR3		;SPECIR4 -1 FRACTION CHECK
	TST	R4
	BNE	M.NOR4
	SEC			;IT WAS -1 TO MAKE IT -1/2
	ROR	R2
	INC	R3
	INC	R1
M.NOR4:	SEC
M.NOR3:	ROR	R2
	ROR	R4
M.RET2:	MOV	R4,(R0)+
	MOV	R2,(R0)+
	MOV	R3,(R0)+
	CMP	R3,R1
	BHI	M.RET3		;MAKE SURE THE VALUE DIDN'T DECREASE
	CLV		
	RTS	PC		;BACK
; TSTCH - TST00, TEST ALPHABETIC VS NUMERIC IN R2
;	REGISTERS USED - R2
TST00:	CMP	R2,#'0		;CHECK NUMERIC
	BLT	TST03		;NON-NUMERIC
	CMP	R2,#'9		;CHECK ALPHA
	BGT	TST01		;NON-NUMERIC
	SEZ			;SET ZERO CODE IF NUMERIC
	RTS	PC

TST01:	CMP	R2,#'A		;ALPHABETIC?
	BLT	TST03		;NO
	CMP	R2,#'Z		;ALPHABETIC?
	BGT	TST03		;NO
	CCC			;SET NON-ZERO CODE IF ALPHABETIC
	RTS	PC

TST03:	CCC
M.RET3:	SEV			;SET
	RTS	PC		;OVERFLOW IF NEITHER


.SIZE.	=	.-.BEGIN	;CALCULATE THE SIZE OF US
;INTEGER NEXT PUSHPOPS

NEXTI:	MOV	#UJ,-(SP)	;SET UP EXIT THRU INTERNAL JUMP
	BR	FXNEXT

NEXTIX:	MOV	#UJX,-(SP)	;SET UP EXIT THRU EXTERNAL JUMP
FXNEXT:	MOV	SPDA,R3		;R3 _ BASE
	IF  NEXDRO(R3),HI,RPTERM(R3),FXNEX3  ;DROP THROUGH IF END OF LOOP & DROP SET
	LOAD	R0		;1ST ARG INTO R0
	IFZERO	EQ,R0,CMNEXT	;BRANCH ON NO VARIABLE
	ADD	R3,R0		;BIAS ADDR OF VARIABLE
	LOAD	R2		;2ND ARG INTO R2
	ASR	R2		;SET CARRY IF INCREMENT OF ONE
	BCC	FXNEX1		;BRANCH IF NOT ONE
	IFZERO	EQ,RPTERM(R3),FXNEX6  ;BR IF DONE LOOPING
	INC	(R0)		;INCREMENT VARIABLE
FXNEX2:	MOV	#-1,RPTERM(R3)	;SET LOOPING FLAG
	CLR	NEXDRO(R3)	;CLEAR DROP THRU FLAG
	RTS	PC

FXNEX1:	ASL	R2		;RESTORE ADDR OF INCREMENT
	ADD	R3,R2		;BIAS ADDR OF INCREMENT
	IFZERO	EQ,RPTERM(R3),FXNEX5  ;BR IF DONE LOOPING
	ADD	(R2),(R0)	;INCREMENT VARIABLE
	BR	FXNEX2		;GO CLR DROP THRU FLAG

FXNEX3:	ADD	#4,R5		;TAKE IPC PAST ARGUMENTS
FXNEX4:	TST	(SP)+		;DON'T EXIT THRU A JUMP
	BR	CMNEXT		;JUST DROP THRU TO INTERP

FXNEX5:	SUB	(R2),(R0)	;DEC CNTRL VARIABLE AT END OF FOR LOOPING
	BR	FXNEX4		;AND JUST DROP THRU

FXNEX6:	DEC	(R0)		;DEC CNTRL VAR AT END OF FOR LOOPING
	BR	FXNEX4		;AND JUST DROP THRU
;FLOATING NEXT PUSHPOPS

NEXTF:	MOV	#UJ,-(SP)	;SET UP EXIT THRU INTERNAL JUMP
	BR	FLNEXT

NEXTFX:	MOV	#UJX,-(SP)	;SET UP EXIT THRU EXTERNAL JUMP
FLNEXT:	MOV	SPDA,R3		;R3 _ BASE
	IF  NEXDRO(R3),HI,RPTERM(R3),FXNEX3  ;DROP THRU  IF END OF LOOP & DROP SET
	LOAD	R0		;1ST ARG INTO R0
	IFZERO	EQ,R0,CMNEXT	;BRANCH ON NO VARIABLE
	JSR	PC,PUSHF3	;PUSH VARIABLE
	MOV	R0,-(SP)	;SAVE ITS ABSOLUTE ADDR
	LOAD	R0		;2ND ARG INTO R0
	ASR	R0		;SET CARRY IF INCREMENT OF ONE
	BCC	FLNEX1		;BRANCH IF NOT ONE
	JSR	PC,PUSHF1	;PUSH ONE
FLNEX2:	IFZERO	EQ,RPTERM(R3),FLNEX5  ;BR IF DONE LOOPING
	JSR	PC,ADDF		;INCREMENT VARIABLE
FLNEX6:	MOV	SPDA,R3		;R3 IS THE BASE REGISTER
	MOV	(SP)+,R0	;RESTORE VARIABLE
	JSR	PC,POPF1	;POP VARIABLE & EXIT
	BR	FXNEX2

FLNEX1:	ASL	R0		;RESTORE INCREMENT ADDR
	JSR	PC,PUSHF3	;PUSH INCREMENT
	BR	FLNEX2

FLNEX5:	JSR	PC,SUBF		;DEC CNTRL VAR AT END OF FOR LOOPING
	MOV	(SP)+,(SP)	;GET RID OF EXIT THRU A JUMP
	CMPB	(R5)+,(R5)+	;SKIP OVER INTERP. JUMP ADDR
	BR	FLNEX6		;RESTORE VARIABLE AND DROP THRU

CMNEXT:	CMPB	(R5)+,(R5)+	;KICK IPC PAST ONE ARGUMENT
	BR	FXNEX2		;BR TO GENERAL EXIT
;INTEGER FOR PUSHPOPS

FORI:	MOV	#PIFJ,-(SP)	;SET UP RETURN THRU INTERN. FALSE JUMP
	BR	FXFOR

FORIX:	MOV	#PIFJXN,-(SP)	;SET UP EXTERNAL "FOR" FALSE JUMP
FXFOR:	CLR	-(R1)		;TRUTH VALUE TO FALSE
	LOAD	R0		;VARIABLE ADDR INTO R0
	ADD	SPDA,R0		;BIAS IT
	LOAD	R2		;2ND ARG INTO R2
	ADD	SPDA,R2		;BIAS IT
	ASR	R2		;SET CARRY IF INCREMENT IS ONE
	BCC	FXFOR1		;BRANCH IF NOT ONE
	ASL	R2		;LIMIT ADDR INTO R2
FXFOR3:	IF	(R0),GT,(R2),FXFOR2 ;BRANCH IF VARIABLE GT LIMIT
FXFOR4:	COM	(R1)		;TRUTH VALUE TO TRUE
FXFOR2:	RTS	PC

FXFOR1:	ASL	R2		;RESTORE INCREMENT ADDR
	IFSIGN	(R2)+,PL,FXFOR3	;BRANCH ON POSITIVE INCREMENT
	IF	(R0),GE,(R2),FXFOR4 ;BRANCH IF VARIABLE GE LIMIT
	RTS	PC
;FLOATING FOR PUSHPOPS

FORF:	MOV	#PIFJ,-(SP)	;SET UP RETURN THRU INTERN. FALSE JUMP
	BR	FLFOR

FORFX:	MOV	#PIFJXN,-(SP)	;SET UP EXTERNAL "FOR" FALSE JUMP
FLFOR:	JSR	PC,PUSHF	;PUSH VARIABLE
	LOAD	R0		;2ND ARG INTO CARRY
	ADD	SPDA,R0		;BIAS ADDR OF 2ND ARG
	ASR	R0		;SET CARRY IF INCREMENT IS ONE
	BCC	FLFOR1		;BRANCH IF NOT ONE
	ASL	R0		;LIMIT ADDR INTO R0
FLFOR2:	JSR	PC,PUSHF2	;PUSH LIMIT
	JMP	.LE.F		;EXIT WITH LE TEST

FLFOR1:	ASL	R0		;VARIABLE ADDR INTO R0
	ADD	#6,R0		;LIMIT ADDR INTO R0
	IFSIGN	-4(R0),PL,FLFOR2 ;BR IF INCREMENT POSITIVE
	JSR	PC,PUSHF2	;PUSH LIMIT
	JMP	.GE.F		;EXIT WITH GE TEST
;THESE ROUTINES DO THE PUSHPOPS FOR "WHILE" OR "UNTIL"
;CONTROLLED MODIFIERS

REPTI:
REPTF:	MOV	#IFJ2,-(R1)	;SAVE END OFFSET FOR ENDRPT
	BR	REPT2
REPTIX:
REPTFX:	MOV	#IFJXN2,-(R1)	;SAVE END OFFSET FOR ENDRPT
REPT2:	ADD	#4,R5		;IPC TO THIRD ARG
	MOVB	(R5)+,-(R1)	;SAVE TENTATIVE JUMP ADDR
	MOVB	(R5)+,-(R1)
	RTS	PC		;DO THE CONDITIONAL

;AT THE END OF THE CONDITIONAL, WE'LL COME HERE

ENDRPT:	JSR	PC,SETDRO	;SET THE DROP THRU FLAG FOR SUBSEQ. "NEXT"
	MOV	(R1)+,(R2)	;TRUTH VALUE TO RPTERM
	MOV	(R1)+,R0	;TENTATIVE JUMP ADDR TO R0
	TST	(R2)
	JMP	@(R1)+		;EXIT THRU APPROP. COND. JUMP

SETDRO:	MOV	SPDA,R2		;R2 _ BASE
	ADD	#NEXDRO,R2	;ABS ADDR NEXDRO FLAG INTO R2
	MOV	#-1,(R2)+	;SET NEXDRO & INC R2 TO ADDR OF RPTERM
	RTS	PC
;CHECKS THE STRING AT THE TOP OF THE STACK FOR INCLUSION
;IN THE NEXT STRING ON THE STACK AS A SUBSTRING
;AT OR BEYOND THE POSITION SPECIFIED BY THE NUMBER WHICH
;FOLLOWS ON THE STACK - IF INCLUDED, RETURNS THE
;CHARACTER POSITION AT WHICH FIRST OCCURRENCE STARTS -
;IF NOT, RETURNS 0 - THE NULL STRING IS A SUBSTRING
;OF EVERY STRING IMMEDIATELY

INSTR:	JSR	R5,INTFUN	;GET THE ARGS STRAIGHTENED OUT
	ARGS	FAI,FAS,FAS	;INTERGER-STRING-STRING ARGS
	MOV	R5,-(SP)	;SAVE IPC
	MOV	SPDA,R2		;R2 IS THE BASE REGISTER
	MOV	R1,R5		;R5 _ OLD R1 STACK PTR
	JSR	PC,PSTJS	;THROW OUT TOP STRING
	MOV	R1,R0		;R0 _ NEW R1 STACK PTR
	MOV	-(R0),R4	;R4 _ LENGTH OF SUPPOSED SUBSTRING
	ADD	-(R0),R5	;R5 _ ITS ADDR
	MOV	R1,R2		;R2 _ OLD R1 STACK PTR
	JSR	PC,PSTJS	;THROW OUT TOP STRING
	MOV	R1,R0		;R0 _ NEW R1 STACK PTR
	MOV	-(R0),R3	;R3 _ LENGTH OF SUPPOSED OUTER STRING
	ADD	-(R0),R2	;R2 _ ITS BEG ADDR
	DEC	(R1)		;DEC CHAR POSITION TO START AT
	BPL	INSTR0		;BRANCH ON POSITIVE CHAR POSITION
	CLR	(R1)		;EARLY START CORRECTION
INSTR0:	ADD	(R1),R2		;START AT INDICATED CHAR
	SUB	(R1),R3		;WITH APPROPRIATE LENGTH
INSTR1:	IF  R4,GT,R3,INSTR2	;BRANCH IF NO ROOM FOR INCLUSION
	INC	(R1)		;OTHWS, ADVANCE POSITION INDICATIO
	CLR	R0		;CLR CHAR MATCH COUNTER
INSTR4:	IF  R0,EQ,R4,INSTR3	;BRANCH IF SUBSTRING FOUND
	INC	R0		;OTHWS, INC MATCH COUNTER
	IF  (R2)+,EQ,(R5)+,INSTR4,B  ;LOOP BACK ON CHAR MATCH
	SUB	R0,R5		;RESTORE BEG OF SUPPOSED SUBSTRING
	INC	R2		;TRY ONE CHAR FURTHER DOWN
	SUB	R0,R2		;OF SUPPOSED OUTER STRING
	DEC	R3		;DEC ITS LENGTH
	BR	INSTR1		;AROUND OUTER LOOP AGAIN

INSTR2:	CLR	(R1)		;SEND BACK A 0 TO INDICATE FAILURE
INSTR3:	MOV	(SP)+,R5	;RESTORE IPC
	JMP	FLT		;FLOAT POSITION COUNT & EXIT

;CONCATENATE ROUTINE
CONCAT:	MOV	4(R1),R3	;R3 _ LENGTH OF 2ND STRING
	ADD	10.(R1),R3	;PLUS LENGTH OF 1ST STRING
	JSR	PC,BUILDS	;START TO BUILD THE STRING
	MOV	#MATBLK,R4	;R4_ADDR TEMP STORAGE BLOK
	ADD	R0,R4		;BIAS BLOCK ADDR
	CLR	(R4)+		;PUT A 0 BLOCK LENGTH INTO BLOCK AS FLAG
	MOV	R1,R5
	TST	(R1)+		;SKIP OVER LINK
	ADD	(R1)+,R5	;ABS ADDR 2ND STRING INTO R5
	MOV	(R1)+,(R4)+	;ITS LENGTH INTO BLOCK
	MOV	R1,R2
	TST	(R1)+		;SKIP LINK OF 1ST STRING
	ADD	(R1)+,R2	;UNBIASED ADDR OF 1ST STRING IN R2
	MOV	(R1)+,(R4)	;LENGTH OF 1ST STRING INTO BLOCK
	ADD	#6,(R0)		;THROW OUT FIRST STRING HEADER
CONCA1:	DEC	(R4)		;DEC LENGTH OF ONE OF STRINGS
	BMI	CONCA2		;DONE WITH THIS STRING IF NEG
	MOVB	(R2)+,(R3)+	;OTHWS, TRANSFER A CHAR
	BR	CONCA1		;AROUND AGAIN

CONCA2:	MOV	R5,R2		;R2 _ ADDR OF 1ST STRING
	IFZERO	NE,-(R4),CONCA1	;GO AROUND AGAIN IF NONZERO LENGTH
	BR	MID6		;EXIT
;PUSHPOP FOR MID

SUBST1:	JSR	R5,INTFUN	;STRAIGHTEN OUT ARGS
	ARGS	FAS,FAI,FAI	;STRING-INTEGER-INTEGER ARGS
	MOV	(R1)+,R3	;R3_SUBSTRING LENGTH
MID1:	MOV	(R1)+,R4	;R4_CHAR POSITION
	DEC	R4		;A LITTLE SMOOTHER DECREMENTED
	BPL	MID2		;BRANCH ON POSITIVE CHAR POSITION
MID5:	CLR	R4		;PRETEND IT WAS 1
MID2:	MOV	R4,R2		;R2 _ ADJUSTED CHAR POSITION
	NEG	R2		;NEGATED
	ADD	4(R1),R2	;R2 _ LENGTH OF REMAINDER OF STRING
	IF  R3,GE,R2,MID3	;BR IF PUTATIVE LENGTH GR THAN REST OF STRING
	MOV	R3,R2		;ANYWAY, R2 _ LESSER LENGTH
MID3:	MOV	R2,R3		;AND SO DOES R3
	JSR	PC,BUILDS	;BUILD SUBSTRING ON R1 STACK
	ADD	R1,R4		;PREPARE TO DERELATIVIZE
	TST	(R1)+		;POINT AT STRING PTR
	ADD	(R1)+,R4	;R4_ABS. ADDR 1ST SUBSTRING CHAR
MID4:	DEC	R2		;DECREMENT LENGTH
	BMI	MID9		;BRANCH IF DONE
	MOVB	(R4)+,(R3)+	;TRANSFER A CHAR
	BR	MID4
MID9:	TST	(R1)+		;ADJUST R1 TO POINT JUST ABOVE HEADER
MID6:	JSR	PC,@(SP)+	;FINISH UP IN BUILDS
MID8:	MOV	(SP)+,R5	;RESTORE IPC
	RTS	PC
;PUSHPOP FOR RIGHT

SUBSTR:	JSR	R5,INTFUN	;STRAIGHTEN OUT ARGS
	ARGS	FAS,FAI		;STRING-INTEGER ARGS
	MOV	#77777,R3	;FAR FAR RIGHT INDEED
	BR	MID1		;PROCESS AS VARIANT OF MID

LEFT:	JSR	R5,INTFUN	;STRAIGHTEN OUT ARGS
	ARGS	FAS,FAI		;STRING-INTEGER ARGS
	MOV	(R1)+,R3	;R3_SUBSTRING LENGTH
	BR	MID5
CHR$:	JSR	R5,INTFUN	;FIX ARG IF NECESSARY
	ARG	FAI
	MOV	(R1)+,R2	;R2_ASCII VALUE CHAR
	CLR	R3		;APPROX LENGTH OF STRING
	JSR	PC,BUILDS	;BUILD THE STRING ETC
	MOVB	R2,(R3)+	;MOVE THE CHARACTER IN
	BR	CVS3		;PUT NEW HEADER ON LIST & EXIT

POSF:	TST	(R1)		;SEE IF ANY ARGUMENT
	BEQ	POS01		;BRANCH IF ZERO ASSUMED
	JSR	R5,INTFUN	;CALL THE COMMON FUNCTION INTERPRETER
	ARG	FAI		;ONE INTEGER
POS01:	MOV	(R1)+,R3	;GET THE WANTED POSITION
	ASL	R3		;BY TWO
	ASL	R3		;BY FOUR
	ASL	R3		;BY EIGHT
	ASL	R3		;TO A WORD INDEX
	BIC	#177400,R3	;NO ERRORS HERE
	ADD	#BASE+IOLEN,R3	;GO TO BUFFER HEADER RELATIVE
	ADD	SPDA,R3		;TO THE ABSOLUTE PLACE
	MOV	POSITN(R3),-(R1)	;SOCK IT AWAY
	JMP	FLT		;AND MAKE IT FLOATING

;	DO THE TAB FUNCTION
TABF:	JSR	R5,INTFUN	;CALL THE OFFICIAL PDP-11 FUNCTION
	ARG	FAI		;INTERPRETER
	MOV	SPDA,R2		;GET A DATA AREA POINTER
	MOV	CURRIO(R2),R4	;PUT IN R4 THE REL BUFFER HEADER
	BEQ	SPAC02		;EXIT NOW IF NOT IN IO
	ADD	R4,R2		;COMPUTE ABSOLUTE
	MOV	(R1)+,R4	;GET WANTED
	SUB	POSITN(R2),R4	;CALCULATE NEEDED NUMBER
	BR	SPAC02		;AND GO MAKE THAT MANY OF THEM

SPACES:	JSR	R5,INTFUN	;FIX ARG IF NECESSARY
	ARG	FAI		;WANT AN INTEGER ARGUMENT
	MOV	(R1)+,R4	;R4 _ NUMBER OF SPACES IN STRING
SPAC02:	MOV	R4,R3		;ALSO R3
	BPL	SPAC03		;BRANCH IF POSITIVE LENGTH
	CLR	R3		;ELSE MAKE  NO STRING
SPAC03:	JSR	PC,BUILDS	;BEGIN TO BUILD THE STRING
SPAC1:	DEC	R4		;DECREMENT STRING LENGTH
	BMI	CVS3		;EXIT WHEN LENGTH COUNT GOES NEGATIVE
	MOVB	#' ,(R3)+	;OTHWS, ADD A SPACE TO THE STRING
	BR	SPAC1		;AND GO ROUND AGAIN
;CONVERT VECTOR TO STRING

CVS:	CLR	-(R1)		;INITIALIZE TO ZEROTH ENTRY
	JSR	PC,CVSPUS	;PUSH FIRST ENTRY
	MOV	(R1)+,R4	;R4_STRING LENGTH
	MOV	R4,R3		;SO DOES R3
	JSR	PC,BUILDS	;BUILD THE STRING
CVS1:	DEC	R4		;DEC LENGTH
	BMI	CVS2		;ALMOST DONE IF NEGATIVE
	SUB	R0,R3		;GUARD AGAINST DISASTER
	MOV	2(SP),R5	;R5 _ RELATIVE IPC SAVED BY BUILDS
	ADD	SPTA,R5		;NOW IPC ABSOLUTE
	CMPB	-(R5),-(R5)	;BUT WE HAVE TO POINT AT ARRAY ADDRESS
	JSR	PC,CVSPUS	;PUSH ENTRY
	ADD	R0,R3		;UNGUARD
	MOV	(R1)+,R2	;R2_MATRIX ENTRY
	MOVB	R2,(R3)+	;PUT L.S. BYTE INTO STRING
	BR	CVS1		;AND AROUND AGAIN
CVS2:	TST	(R1)+		;GET RID OF RUNNING ARRAY INDEX
CVS3:	JSR	PC,@(SP)+	;RETURN TO BUILDS TO FINISH UP
	MOV	(R2),(R1)	;LINK _ RELATIVE PTR TO 1ST STRING HEADER
	JSR	PC,PUSHS2	;PUT HEADER ON HEADER LIST
	BR	MID8

;TURNS A STRING INTO AN ARRAY

CSV:	CLR	-(SP)		;INITIALIZE TO ZEROTH ENTRY
	MOV	4(R1),-(R1)	;STRING LENGTH TO TOP OF STACK
	JSR	PC,CSVPOP	;SALT IT AWAY IN ARRAY
	MOV	R1,R4		;R4 _ R1 STACK POINTER
	JSR	PC,PSTJS	;POP STRING TO J SPACE
	MOV	-(R1),R3	;R3 _ STRING LENGTH
	ADD	-(R1),R4	;R4 _ ABS STRING POINTER
	CMP	(R1)+,(R1)+	;CLEAN UP R1 STACK
CSV1:	DEC	R3		;DECREMENT LENGTH
	BMI	CSV2		;DONE IF NEGATIVE
	CLR	-(R1)		;OTHWS,SET UP ANOTHER POP
	MOVB	(R4)+,(R1)	;WITH BYTE FROM THE STRING
	SUB	R0,R4		;GUARDING AGAINST DISASTER
	CMPB	-(R5),-(R5)	;ADJUST IPC FOR NEXT POP
	JSR	PC,CSVPOP	;POP R1 STACK TO MATRIX
	ADD	R0,R4		;DANGER BEHIND US
	BR	CSV1		;AROUND AGAIN

CSV2:	TST	(SP)+		;RID OF RUNNING ARRAY INDEX
	RTS	PC
;SPECIAL PUSH FOR CVS ROUTINE - FIXES THE PUSHED ITEM
;IF IT WAS A FLOATER-SAVES R3 & R4
;EXIT WITH R0 = SPDA - JSR PC

CVSPUS:	MOV	R3,-(SP)	;SAVE R3 & R4
	MOV	R4,-(SP)
	MOV	(R1),-(R1)	;ARRAY INDEX _ RUNNING INDEX
	INC	2(R1)		;INCREMENT RUNNING INDEX
	JSR	PC,INDO1	;PUSH ARRAY ENTRY
	JMASK0	NE,(R0),FIXARY,CVSPU1,B	;BR ON FIXED NUM
	JSR	PC,FIX		;OTHWS, FIX IT
CVSPU1:	MOV	(SP)+,R4	;RESTORE R4 & R3
	MOV	(SP)+,R3
	MOV	SPDA,	R0	;BUT SET R0 TO SPDA
	RTS	PC

;SPECIAL POP FOR CSV ROUTINE - POPS THE TOP INTEGER
;(FLOATED, IF NEED BE) INTO ARRAY - SAVES R3 & R4 -
;EXIT WITH R0 = SPDA - JSR PC

CSVPOP:	MOV	R3,-(SP)	;SAVE R3 & R4
	MOV	R4,-(SP)
	MOV	6(SP),-(R1)	;ARRAY INDEX _ RUNNING INDEX
	INC	6(SP)		;INCREMENT RUNNING INDEX
	CLR	-(R1)		;DUMMY IN 2ND INDEX OF ZERO
	JSR	PC,INDX90	;CALL ARRAY PREFACE
	JMASK0	NE,(R0),FIXARY,CSVPO,B  ;BR IF INTEGER ARRAY
	MOV	R0,-(SP)	;SAVE R0 & R3 FOR INDR-ROUTINE
	MOV	R3,-(SP)
	JSR	PC,FLT		;FLOAT THE NUMBER
	MOV	(SP)+,R3	;RESTORE R0 & R3 FOR INDR-ROUTINE
	MOV	(SP)+,R0
CSVPO:	JSR	PC,INDR3	;POP TO ARRAY
	BR	CVSPU1		;RESET R3 & R4 AND SET R0 TO SPDA
DATE$:	JSR	R5,INTFUN	;SEE WHAT WE'VE GOT
	ARG	FAI		;WE'D LIKE AN INTEGER
DATE07:	MOV	(R1)+,R4	;GET THE ARGUMENT
	BNE	DATE00		;BRANCH IF SUPPLIED
	MOV	DATE,R4		;ELSE USE TODAY FOR FUN
DATE00:	MOV	#9.,R3		;WE NEED 9 BYTES(10 FOR SAFE SIDE)
	JSR	PC,BUILDS	;GO SET UP FOR STRING BUILD
	JSR	R5,SAVREG	;SAVE ALL REGISTERS
	MOV	#69.,R5		;YEAR COUNTER
DATE05:	INC	R5		;TALLY A YEAR
	SUB	#1000.,R4	;SEE IF DONE COUNTING YEARS
	BHIS	DATE05		;LOOP IF MORE TO DO
	CLR	R0		;LEAP YEAR CORRECTION
	BIT	R5,#3		;SEE IF THIS IS THE YEAR
	BNE	DATE10		;BRANCH IF NEXT YEAR 
	INC	R0		;FEBRUARY CORRECTION
	DEC	R4		;AND MAKE THE DAYS FUNNY
DATE10:	MOV	#DATTBL,R2	;DATES AND NAMES
	MOV	(R2)+,R1	;SEE IF DEC DATE
DATE15:	ADD	R1,R4		;ADD THIS MONTHS DAYS
	BGT	DATE40		;BRANCH IF ALL CALCULATED
	ADD	#3,R2		;GO TO THE NEXT MONTH
	MOVB	(R2)+,R1	;GET THE NUMBER OF DAYS
	BEQ	DATE20		;EXIT IF SCREWY DATE
	CMP	R2,#FEBRY	;SEE IF THE FUNNY MONTH
	BNE	DATE15		;BRANCH IF REGULAR MONTH
	ADD	R0,R1		;LEAP YEAR CORRECTION--YEA!
	BR	DATE15		;AND MORE HUM-DRUMS

DATE20:	CLR	R4		;CLEAR DAY NUMBER
DATE40:	JSR	PC,DATE25	;GO OUTPUT TWO CHARACTERS
	MOVB	#'-,(R3)+	;STORE -
	MOVB	(R2)+,(R3)+	;MONTH 1
	MOVB	(R2)+,(R3)+	;MONTH 2
	MOVB	(R2)+,(R3)+	;MONTH 3
	MOVB	#'-,(R3)+	;ANOTHER -
	JSR	PC,DATE25	;NOW OUTPUT THE YEAR
DATE90:	MOV	R3,6(SP)	;UPDATE THE SAVED R3
	JSR	R5,RESREG	;RESTORE REGS
	JMP	CVS3		;EXIT LIKE OTHERS HAVE
DATTBL:	.WORD	666.		;DECEMBER ADJUSTMENT
	.BYTE	    'D,'E,'C
	.BYTE	30.,'N,'O,'V
	.BYTE	31.,'O,'C,'T
	.BYTE	30.,'S,'E,'P
	.BYTE	31.,'A,'U,'G
	.BYTE	31.,'J,'U,'L
	.BYTE	30.,'J,'U,'N
	.BYTE	31.,'M,'A,'Y
	.BYTE	30.,'A,'P,'R
	.BYTE	31.,'M,'A,'R
FEBRY:	.BYTE	28.,'F,'E,'B
	.BYTE	31.,'J,'A,'N
	.BYTE	00.,'X,'X,'X		;SCREWY MONTH NAME
	.EVEN			;FOR A NICE ASSEMBLY
DATE25:	MOV	#35057,R1	;ASCII START BOTH BYTES
DATE30:	INC	R1		;INTEGER TO ASCII SHORT STYLE
	SUB	#10.,R4		;DECREMENT
	BHIS	DATE30		;LOOP TILL DONE
	CMPB	R1,#72		;SEE IF 100 AND SHOULD BE 0
	BLT	DATE35		;BRANCH IF ALL OK
	SUB	#10.,R4		;ADJUST THE YEAR NUMBER
DATE35:	MOVB	R1,(R3)+	;STORE THE FIRST BYTE
	SWAB	R1		;NEXT HALF
	ADD	R4,R1		;MAKE NEXT DIGIT
	MOVB	R1,(R3)+	;AND STORE IT TOO
	MOV	R5,R4		;SEE IF THIS IS THE YEAR
	RTS	PC		;AND RETURN

TIME$:	JSR	R5,INTFUN	;CLEAN UP THE ARGS IF NEEDED
	ARG	FAI		;WE NEED ONE INTEGER
TIME07:	MOV	(R1)+,R4	;GET THE NUMBER
	BNE	TIME00		;BRANCH IF HE SUPPLIED IT
	MOV	TIME,R4		;ELSE USE THE TIME RIGHT NOW
TIME00:	MOV	#8.,R3		;WE'LL NEED 8 CHARACTERS
	JSR	PC,BUILDS	;GO SET UP A STRING
	JSR	R5,SAVREG	;SAVE ALL THE REGISTERS
TIME05:	MOV	#"PM,-(SP)	;PUT THE SUFFIX ON THE STACK
	CMP	R4,#720.	;SEE IF MORNING OR AFTERNOON
	BLE	TIME10		;BRANCH IF NIGHT TIME
	MOV	#"AM,(SP)	;ELSE MAKE IN THE AM STYLE
	SUB	#720.,R4	;ADJUST FOR BEING UP THAT EARLY
TIME10:	MOV	#12.,R5		;HOUR COUNTER
TIME15:	DEC	R5		;DECREMENT HOURS
	SUB	#60.,R4		;AND DEDUCT AN HOURS TIME
	BGT	TIME15		;LOOP TILL NEGATIVE
	TST	R5		;SEE IF 12:00--12:59
	BNE	TIME20		;BRANCH IF LATTER
	MOV	#12.,R5		;ELSE MAKE 12 O'CLOCK
TIME20:	NEG	R4		;MAKE MINUTES COUNT POSITIVE
	MOV	R5,-(SP)	;SAVE R5
	MOV	R4,R5		;SWAP R4 AND R5
	MOV	(SP)+,R4	;FINISH UP THE SWAP
	JSR	PC,DATE25	;OUTPUT TWO CHARACTERS
	MOVB	#':,(R3)+	;AND A DIVIDER
	JSR	PC,DATE25	;NOW THE MINUTES
	MOVB	#' ,(R3)+	;AND A SPACE
	MOV	(SP)+,(R3)+	;AND THE MORNING AFTERNOON TAG
	BR	DATE90		;AND EXIT
;PUTS A STRING ON THE R1 STACK - CALLING SEQUENCE:
;		R3 _	TIGHT UPPER BOUND ON STRING LENGTH
;		JSR	PC,BUILDS	(NO ABS POINTERS & NO STRING DATA POINTERS)
;		INITIALIZE
;	LOOP:	GO RET IF CONDITION FOR STRING END MET
;		GET READY TO SHIP CHAR (KEEPING R0 _ SPDA
;					AND R3 PROPERLY ABSOLUTE)
;		(R3)+ _	CHAR
;		BR	LOOP
;	RET:	JSR	PC,@(SP)+
;		MOV	(R2),(R1)	(TO PUT NEW HEADER ON LIST)
;		JSR	PC,PUSHS2
;		   OR	NOTHING		(IF PREVIOUS ITEM 
;					ON R1 STACK WAS A STRING
;					HEADER STILL ON HEADER LIST
;					WHOSE LINK IS UNDESTROYED BY
;					R1 STACK DIDDLING IN THE
;					CHAR TRANSMISSION PORTION OF
;					COROUTINE)
;		MOV	(SP)+	R5	(TO RESTORE IPC IF R5 ORIG IPC)
;		   OR	TST (SP)+ (IF R5 NOT IPC AT ENTRY)
;		EXIT	CODE
;AT FIRST EXIT TO COROUTINE, R3 IS ABSOLUTE ADDR OF
;FIRST STRING BYTE TO BE STORED INTO - AT ALL
;EXITS, R0 IS SPDA, AND MUST BE SO MAINTAINED -
;AT LAST EXIT R2 IS ALSO SPDA - WARNING:  THE VALUE
;OF SPDA & SPTA MAY CHANGE BETWEEN THE INITIAL ENTRY TO BUILDS
;AND THE FIRST EXIT TO COROUTINE - IF R5 CONTAINS
;IPC, AN APPROPIATELY UPDATED VERSION IS ON THE SP STACK AT
;EXIT - OTHWS, JUNK WORD ON STACK AT EXIT
;DOES NOT USE R2, R4, OR R5 EXCEPT FOR THE RETURN OF SPDA IN R2 AT LAST EXIT
BUILDS:	MOV	SP,R0		;KEEP BACK UP OF STACK POINTER
	MOV	(SP),-(SP)	;MAKE A SLOT FOR IPC
	MOV	R5,(R0)		;SLOT _ IPC
	SUB	SPTA,(R0)	;RELATIVIZE W.R.T. SPTA
	MOV	SPDA,R0		;R0 IS THE BASE REGISTER
	BIC	#1,R3		;MAKE STRING LENGTH EVEN
	BPL	BLDS0		;BR IF STRING LENGTH NONNEGATIVE
	CLR	R3		;OTHWS, MAKE IT AT LEAST 0
BLDS0:	TST	(R3)+		;ADD A LITTLE
	MOV	R3,STRNOM(R0)	;TELL GARBAGE COLLECTOR HOW MUCH - JUST IN CASE
	ADD	NEXSTR(R0),R3	;R3 _ APPROX. END OF STRING TO BE BUILT
	IF R3,LO,STRLIM(R0),BLDS1  ;BRANCH IF ROOM FOR STRING
	JSR	PC,STROUT	;GET SPACE
BLDS1:	MOV	NEXSTR(R0),R3	;R3 _ NEXT AVAILABLE BYTE IN STRING SPACE
	ADD	R0,R3		;BIAS R3
	JSR	PC,@(SP)+	;GO BUILD THE STRING, ETC
	SUB	R0,R3		;UNBIAS R3
	MOV	R3,-(R1)	;LENGTH _ REL LOC OF NEXT FREE STRING BYTE
	MOV	R3,-(R1)	;STRING LINK DOES TOO
	ADD	R0,(R1)+	;STRING LINK _ ABS ADDR
	SUB	NEXSTR(R0),(R1)	;LENGTH _ LENGTH OF STRING BUILT
	BGT	BLDS2		;BRANCH IF POSITIVE LENGTH
	CLR	(R1)		;ELSE MAKE ZERO LENGTH
BLDS2:	SUB	(R1),-(R1)	;STRING LINK _ ABS ADDR OF STRING BUILT
	TST	-(R1)		;POINT AT LINK
	SUB	R1,2(R1)	;RELATIVIZE PTR
	INC	R3		;MAKE R3 EVEN (ROUND UP)
	BIC	#1,R3
	MOV	R3,NEXSTR(R0)	;UPDATE NEXT AVAIL STRING BYTE ADDR
	ADD	SPTA,2(SP)	;MAKE POSSIBLE IPC ABSOLUTE
	MOV	R0,R2		;PUBLIC SERVICE - R2 _ SET TO BIAS
	RTS	PC
;COMPUTES SQUARE ROOT OF NUMBER AT TOP OF R1 STACK

SQRT:	JSR	R5,INTFUN	;STRAIGHTEN OUT ARGS
	ARG	FAF
	MOV	R1,R0		;DON'T WANT TO DESTROY R1
	IFZERO	NE,(R0)+,SQRT1	;BR IF NOT FLOATING 0 ON R1 STACK
	IFZERO	NE,(R0)+,SQRT1
	CLR	(R0)+		;THERE IS A FL 0
	RTS	PC		;RETURN IT AS ANSWER

SQRT1:	CLR	-(SP)		;TURN OFF N FLAG
	IFSIGN	2(R1),PL,M.BR1	;BR IF NUM NONNEG
	INC	(SP)		;OTHWWS, SET N FLAG
	JSR	PC,NEGF		;AND NEGATE NUMBER
M.BR1:	CMP	(R1)+,(R1)+	;POINT AT EXPONENT
	ADD	#100000,(R1)	;MAKE THE EXPONENT INTO A NUMBER
	ASR	(R1)		;DIVIDE EXP BY 2 MORE OR LESS
	MOV	(R1),-(SP)	;SAVE RESULT
	MOV	#100000,(R1)	;NORMALIZE ON [1/2,1)
	ADC	(R1)		;REALLY NORMALIZE ON [1/2,2) BY ADDING CARRY TO EXPONENT
	MOV	(R1),-(SP)	;SAVE ON SP STACK
	MOV	-(R1),-(SP)
	MOV	-(R1),-(SP)
	TOPR1	MULF,M.BB	;MUL BY M.BB
	TOPR1	ADDF,M.AA	;ADD M.AA
				;INITIAL APPROX IS Y = M.AA + M.BB * X
	JSR	PC,MAPPR	;Y = (X/Y + Y)/2
	JSR	PC,MAPPR	;AGAIN
	JSR	PC,MAPPR	;AGAIN - FINAL NORM VALUE
	ADD	#6,SP		;RID OF NORMALIZED ARG
	ADD	(SP)+,4(R1)	;SET EXPONENT
	ASR	(SP)+		;SET CARRY IF N FLAG ON
	BCC	M.BR3		;BR IF ORIG ARG NONNEG
	SQRERR			;OTHWS, SIGNAL ERROR
M.BR3:	RTS	PC		;RETURN WITH V BIT CLEAR
;COMPUTES (TEMP/TOPR1 + TOPR1)/2

MAPPR:	JSR	PC,DUPLF	;DUPLICATE TOP OF R1
	MOV	6(SP),-(R1)	;PUSH TEMP ONTO R1
	MOV	4(SP),-(R1)
	MOV	2(SP),-(R1)
	JSR	PC,RDIVF	;TEMP/TOPR1
	JSR	PC,ADDF		;+ TOPR1
	DEC	4(R1)		;/2
	RTS	PC

;SQUARE ROOT
M.AA:	070520,040034,100000	;.500868
M.BB:	156764,074255,077777	;.471403


;CALCULATE NATURAL LOG

LOG:	JSR	R5,INTFUN	;STRAIGHTEN OUT ARGS
	ARG	FAF
LOGF:	TST	2(R1)
	BGT	M.XY		;BR ON POSITIVE NUMBER
LOGER:	LOGERR			;BAD ARG TO LOG OR POWER FUNCTION
	RTS	PC

M.XY:	MOV	R1,R0		;TEST FOR FLOATING ONE
	IFZERO	NE,(R1)+,M.XX
	IF (R1)+,NE,#40000,M.XX
	IF (R1)+,NE,#100001,M.XX
	JMP	PUSHF0		;WAS A 1 - EXIT & PUSH 0
M.XX:	MOV	R0,R1		;RESTORE R1
	MOV	4(R1),-(SP)	;SAVE EXPONENT
	ADD	#100000,(SP)	;BUT COMPLEMENT HIGH BIT
	MOV	(R0)+,-(SP)	;SAVE L.S. MANT
	MOV	(R0)+,-(SP)	;SAVE M.S. MANT
	MOV	#100000,(R0)	;X NOW ON [1/2,1)
	MOV	(R0),-(SP)	;SAVE EXPONENT
	TOPR1	SUBF,M.RT2B	;X - SQRT(2)/2
	MOVFLT	(SP)+,-(R1)	;REFRESH X
	TOPR1	ADDF,M.RT2B	;X + SQRT(2)/2
	JSR	PC,DIVF		;(X-SQRT(2)/2)/(X+SQRT(2)/2)
	MOV	R5,-(SP)	;SAVE IPC
	MOV	#M.TABL,R5	;SET UP FOR POLYNOMIAL EVAL
	JSR	PC,MDOPO	;APPROXIMATE THE LOG
	MOV	(SP)+,R5	;RESTORE IPC
	TOPR1	SUBF,M.LGB2	;SUB LN(2)/2 - DONE ON [1/2,1)
	MOV	(SP)+,-(R1)	;FETCH OLD EXPONENT (SLIGHTLY DOCTORED)
	JSR	PC,FLT		;FLOAT IT
	TOPR1	MULF,M.LOGE	;MUL BY LN(2)
	JMP	ADDF		;ADD TO PREV CALC LOG ON [1/2,1]
;LOG
M.RT2B:	074632,055202,100000	;SQRT(2)/2
M.LOGE:	005774,054271,100000	;LN 2
	177771,077777,100001	;1.999999993788
M.NLL:	066333,052525,100000	;.666669470507
	007414,063120,077777	;.399659100019
	125116,046414,077777	;.300974506336
M.TABL:	.WORD	M.NLL		;POINTER TO NEXT-TO-LAST COEFFICIENT

;COMPUTES LOG BASE 10

LOG10:	JSR	PC,LOG		;GET NATURAL LOG
	MOV	#M.M,R0		;MUL BY LOG10(E)
	JSR	PC,PUSHF2
	JMP	MULF		;DO THE MULTIPLY & EXIT

M.M:	166125,067455,077777	;LOG10(E) = .43429 44819 03251
;RAISES 2ND NUMBER ON R1 STACK TO 1ST NUMBER POWER - 2ND NUMBER
;MUST BE NONNEGATIVE UNLESS EXPONENT IS AN INTEGER <= 31

PWRF:	MOV	R1,R0		;R0 POINTS AT EXPONENT
	MOVFLT	(R0)+,-(SP)	;SAVE EXPONENT
	IF  4(R1),HI,#100005,PWR5  ;BR IF EXP >= 32
	JSR	PC,MFRAC1	;INTEGER PART OF EXP ONTO SP STACK, FRACT PART ONTO R1 STACK
	MOV	R1,R0
	ADD	#6,R0		;R0 POINTS AT NUMBER TO EXPONENTIATE
	IFZERO	NE,(R1)+,PWR4	;BR IF EXPONENT NOT AN INTEGER
	IFZERO	NE,(R1)+,PWR4
	CLR	(R1)+		;IT IS AN INTEGER
	IFSIGN	(SP),PL,PWR0	;BR IF EXPONENT POSITIVE
	NEG	(SP)		;OTHWS, NEGATE THE EXPONENT
	JSR	PC,PUSHF1	;AND INVERT THE NUMBER TO EXPONENTIATE
	JSR	PC,RDIVF
PWR0:	ASR	(SP)		;SET CARRY IF EXPONENT ODD
	MOVFLT	(R0)+,-(SP)	;SAVE THE NUMBER
	BCS	PWR1		;IF EXPON ODD, LEAVE NUMBER ON STACK
	MOV	R0,R1		;OTHWS, POP NUMBER
	JSR	PC,PUSHF1	;AND PUSH A ONE IN ITS PLACE
PWR1:	IFZERO	EQ,6(SP),PWR3	;BR IF DONE
PWR2:	MOVFLT	(SP)+,-(R1)	;OTHWS, PUSH SOME POWER OF NUMBER
	JSR	PC,DUPLF	;DUPLICATE IT
	JSR	PC,MULF		;SQUARE IT
	ASR	(SP)		;SET CARRY IF SQUARE TO BE MULTIPLIED IN
	MOVFLT	(R1)+,-(SP)	;SAVE SQUARE
	BCC	PWR2		;BR IF SQUARE NOT MULTIPLIED IN
	SUB	#6,R1		;OTHWS, RECOVER SQUARE
	JSR	PC,MULF		;AND MULTIPLY IT IN
	BR	PWR1
PWR3:	ADD	#14.,SP		;CLEAN THE STACK
	BR	LOGEX		;EXIT WITH OVERFLOW CLEAR

PWRI:	MOV	(R1)+,-(SP)	;SAVE THE POWER
	BLT	PWRI00		;IF NEGITIVE GIVE ZERO RESULT
	MOV	(R1)+,-(SP)	;SAVE THE NUMBER
	MOV	#1,-(R1)	;START THE PRODUCT AT 1
PWRI10:	DEC	2(SP)		;DECREMENT THE COUNT
	BLT	PWRI20		;EXIT IF DONE
	MOV	(SP),-(R1)	;MOVE THE BASE NUMBER
	JSR	PC,MULI		;AND MULTIPLY
	BR	PWRI10		;AND LOOP FOR MORE IF NEEDED

PWRI20:	TST	(SP)+		;POP THE NUMBER
PWRI25:	TST	(SP)+		;POP THE EXPONENT
	RTS	PC		;AND RETURN

PWRI00:	CLR	(R1)		;MAKE RESULT 0
	BR	PWRI25		;AND EXIT NICELY

;WHEN WE GET HERE, THE NUMBER TO EXPONENTIATE HAD BETTER BE NONNEGATIVE

PWR4:	TST	(SP)+		;GET RID OF INTEGER PART OF EXPONENT
PWR5:	MOV	R0,R1		;R1 POINTS TO NUMBER TO EXPONENTIATE
	IFZERO	NE,(R0)+,PWR6	;BR IF NUMBER NONZERO
	IFZERO	NE,(R0)+,PWR6
	CLR	(R0)+		;IT IS A ZERO
	IFSIGN	2(SP),PL,PWR7	;BR IF EXPONENT NONNEGATIVE
	ADD	#6,SP		;CLEAN THE STACK
	JMP	LOGER		;IF EXP NEG, ANSWER IS INFINITY

PWR7:	ADD	#6,SP		;OTHWS, CLEAN STACK & RETURN 0
	BR	LOGEX		;EXIT WITH OVERFLOW OFF

PWR6:	JSR	PC,LOGF		;TAKE LOG OF NUMBER TO EXPONENTIATE
	MOVFLT	(SP)+,-(R1)	;EXPONENT BACK TO R1
	JSR	PC,MULF		;MULT BY LOG OF NUMBER
	BR	EXPF		;AND EXIT THRU EXPONENTIAL ROUTINE
;COMPUTES E TO THE POWER MENTIONED AT THE TOP OF THE R1 STACK

EXP:	JSR	R5,INTFUN	;STRAIGHTEN OUT ARGS
	ARG	FAF
EXPF:	IF 4(R1),LOS,#100016,M.EHEE	;BR IF EXP OF EXP <=14
	EXPERR			;OTHWS, RESULT WILL BE TOO BIG
	RTS	PC

M.EHEE:	MOV	#M.LOG2,R0	;MULT BY LOG2(E) AND PUT
	JSR	PC,MFRAC	;ONE WORD INTEGER PART
;ON SP STACK - FLOATING FRACTION PART ON R1 STACK -
;THE PROBLEM HAS BEEN CONVERTED TO ONE OF RAISING 2 TO
;THE POWER OF THE COMBINED INTEGER AND FRACTION PARTS -
;WE PROCEED TO DO THE FRACTION PART BY CHANGING BASES BACK TO E
	TOPR1	MULF,M.LGB2	;MUL BY LN(2)/2
	JSR	PC,DUPLF	;DUPLICATE NUM AT R1 TOP - CALL IT Y
	INC	10.(R1)		;2Y INTO OLD COPY
	JSR	PC,DUPLF	;COPY Y
	JSR	PC,DUPLF	;R1 STACK NOW 2Y,Y,Y,Y
	JSR	PC,MULF		;2Y,Y,Y^2
	TOPR1	ADDF,M.BB1	;2Y,Y,B1+Y^2
	TOPR1	RDIVF,M.AA1	;2Y,Y,A1/(B1+Y^2)
	JSR	PC,RSUBF	;2Y,A1/(B1+Y^2)-Y
	TOPR1	SUBF,M.MA0	;2Y,A0+A1/(B1+Y^2)-Y
	JSR	PC,DIVF		;Z=2Y/(A0+A1/(B1+Y^2)-Y)
	JSR	PC,PUSHF1
	JSR	PC,ADDF		;Z=1+2Y/(A0+A1/(B1+Y^2)-Y)
	JSR	PC,DUPLF	;COPY Z
	JSR	PC,MULF		;Z^2=2^(FRACTION PART)
	ADD	(SP)+,4(R1)	;INC EXPONENT BY INTEGER PART
LOGEX:	RTS	PC		;EXIT WITH V BIT OFF

;EXPONENTIAL
M.LOG2:	016625,056125,100001	;LOG(2) E
M.LGB2:	005774,054271,077777	;(LN 2)/2
M.MA0:	037345,117741,100004	;-12.015016753875
M.AA1:	041562,132306,100012	;-601.8042666979565
M.BB1:	026573,074056,100006	;60.09019073192600

;COMPUTES COSINE OF NUMBER AT TOP OF R1 STACK
COS:	JSR	R5,INTFUN	;STRAIGHTEN OUT ARGS
	ARG	FAF
COSF:	TOPR1	ADDF,M.PI2	;DO SINE OF X+PI/2
	BR	SINF

;COMPUTES SINE OF NUMBER AT TOP OF R1 STACK
SIN:	JSR	R5,INTFUN	;STRAIGHTEN OUT ARGS
	ARG	FAF
SINF:	IF	4(R1),LOS,#100017,M.SIN1	;BR IF EXP <= 15
	SINERR			;ACCURATE TO LESS THAN 5 PLACES
	ADD	#6,R1
	JMP	PUSHF0		;SEND HIM OR HER BACK A 0
M.SIN1:	MOV	#M.PIE2,R0	;MUL BY 2/PI
	JSR	PC,MFRAC	;ONE WORD INTEGER PART ON SP
;STACK - FLOATING FRACTION PART ON R1 STACK - NOTE
;THAT [0,2PI] HAS BEEN MAPPED ONTO [0,4] -
;THUS, THE LAST 2 BITS OF THE INTEGER PART
;DETERMINE THE QUADRANT
	ASR	(SP)		;SET CARRY IN 2ND & 4TH QUADRANTS
	BCC	M.SIN2		;BR IF IN 1ST OR 3RD QUADRANTS
	JSR	PC,PUSHF1	;OTHWS, X _ 1-X
	JSR	PC,RSUBF
M.SIN2:	ASR	(SP)+		;SET CARRY IN 3RD & 4TH QUADRANTS
	BCC	M.SIN3		;BR IF IN 1ST OR 2ND QUADRANTS
	JSR	PC,NEGF		;X _ -X
M.SIN3:	MOV	R5,-(SP)	;SAVE IPC
	MOV	#M.A11,R5	;SET UP POLYNOMIAL APPROXIMATION
	JSR	PC,MDOPO	;EVAL THE POLYNOMIAL
	MOV	(SP)+,R5	;RESTORE IPC
	RTS	PC		;EXIT WITH OVERFLOW CLEAR
;
;SIN
;THE TWO VALUES USED FOR 2/PI & PI/2 ARE NOT QUITE ACCURATE -
;THEY ARE DOCTORED TO RECIPROCATE PERFECTLY - VALUES OF PI USED WITH THIS
;SYSTEM SHOULD BE 166520,062207,100001


M.PIE2:	140670,050574,100000	;2/PI
M.PI2:	166520,062207,100001	;PI/2
	166521,062207,100001	;REAL VALUE OF PI/2 TO THIS ACCURACY
M.NLS:	006162,126521,100000	;-.64596409264401
	167401,050632,077775	;.07969258728630
	156214,131513,077771	;-.00468162023910
	175321,051777,077764	;.00016021713430
	017672,106516,077756	;-.00000341817225
M.A11:	.WORD	M.NLS		;POINTER TO NEXT-TO-LAST COEFFICIENT
;MULTIPLIES THE NUMBER ON THE R1 STACK BY THE NUMBER
;POINTED AT BY R0 - RETURNS WITH THE FRACTION
;PART ON THE R1 STACK AND THE INTEGER PART (1 WORD)
;ON THE SP STACK - JSR PC
MFRAC:	JSR	PC,PUSHF2	;PUSH NUM POINTED AT BY R0
	JSR	PC,MULF		;MUL BY FORMER TOP OF R1
MFRAC1:	JSR	PC,DUPLF	;MAKE ANOTHER COPY
	JSR	PC,FIX		;GET LARGEST INTEGER CONTAINED
	MOV	(SP),-(SP)	;MOVE RETURN ADDRESS DOWN
	MOV	(R1),2(SP)	;SAVE INTEGER ON SP STACK
	JSR	PC,FLT		;FLOAT THE INTEGER PART
	JMP	SUBF		;EXIT WITH FRACTION PART AT TOP OF R1
;CALCULATES ARCTANGENT OF NUMBER AT TOP OF R1 STACK -
;RESULT NORMALIZED ON [-PI/2,PI/2]
ATAN:	JSR	R5,INTFUN	;STRAIGHTEN OUT ARGS
	ARG	FAF
ATANF:	CLR	-(SP)		;ALL FLAGS OFF
	IFSIGN	2(R1),PL,M.P2	;BR IF X POS
	MOV	#100000,(SP)	;OTHWS, TURN ON NFLAG
	JSR	PC,NEGF		;AND NEGATE F
M.P2:	CMP	#100000,4(R1)	;SET CARRY IF X >= 1
	ROR	(SP)		;AND ALSO AFLAG
	BVC	M.P		;BR IF X < 1
	JSR	PC,PUSHF1	;OTHWS, INVERT X
	JSR	PC,RDIVF
M.P:	TOPR1	CMPF,M.OT32	;COMPARE WITH 2 - SQRT(3)
	BLT	M.EVA1		;BR IF X < 2 - SQRT(3)
	INC	(SP)		;SET BIT IN FLAG WORD : X >= 2 - SQRT(3)
	TOPR1	ADDF,M.ROT3	;X+SQRT(3)
	TOPR1	RDIVF,M.FOUR	;4/(X+SQRT(3))
	TOPR1	RSUBF,M.ROT3	;SQRT(3) - 4/(X+SQRT(3))
M.EVA1:	MOV	R5,-(SP)	;SAVE IPC
	MOV	#M.TAB2,R5	;SET UP POLYNOMIAL EVALUATION
	JSR	PC,MDOPO	;DO THE POLYNOMIAL APPROX.
	MOV	(SP)+,R5	;RESTORE IPC
	ASR	(SP)		;TURN ON CARRY IF AT M.P, X >= 2-SQRT(3)
	BCC	M.EVA2		;BR IF NOT
	TOPR1	ADDF,M.PI6	;IF SO, ADD PI/6 TO APPROX.
M.EVA2:	ASL	(SP)		;TURN ON N IF, AT M.P2, X>- 1
	BPL	M.P6		;BR IF NOT
	TOPR1	RSUBF,M.PI2	;IF SO, ARCTAN=PI/2-ARCTAN
M.P6:	ASL	(SP)+		;TURN ON N IF ORIG X NEG
	BPL	M.TT9		;BR IF NOT
	JMP	NEGF		;OTHWS, NEGATE RESULT
;ARCTAN
M.OT32:	050572,042230,077777	;2-SQRT(3)
M.ROT3:	165641,067331,100001	;SQRT(3)
M.PI6:	044340,041405,100000	;PI/6
M.FOUR:	0,40000,100003		;FLOATING 4
	177775,077777,100000	;.99999999843
M.NLA:	131013,125252,077777	;-.33333289364
	155652,063141,077776	;.19996534780
	107714,133556,077776	;-.14173460613
	113444,060462,077775	;.09491954952
M.TAB2:	.WORD	M.NLA		;POINTER TO NEXT-TO-LAST COEFFICIENT
;EVALUATES ODD POLYNOMIAL IN VARIABLE AT TOP OF R1
;STACK - R5 POINTS TO ADDR OF LOWEST WORD
;OF COEFFICIENT OF NEXT-TO-SMALLEST POWER, WHICH
;ADDR OCCUPIES THE WORD IMMEDIATELY ABOVE THE
;HIGHEST WORD OF THE COEFFICIENT OF THE HIGHEST
;POWER - ASSUMES 3 OR MORE TERMS - JSR PC

MDOPO:	MOV	(R5),-(SP)	;SAVE CUTOFF ADDR
	JSR	PC,DUPLF	;MAKE 2 COPIES OF
	JSR	PC,DUPLF	;TOP NUMBER
	JSR	PC,MULF		;SQUARE A PAIR
	MOVFLT	-(R5),-(R1)	;PUSH TOP COEFFICIENT
M.LOOP:	MOVFLT	10.(R1),-(R1)	;GET THE SQUARE TO THE TOP OF THE STACK
	JSR	PC,MULF		;MUL BY PREV. RESULT
	MOVFLT	-(R5),-(R1)	;PUSH NEXT COEFFICIENT
	JSR	PC,ADDF		;ADD IT INTO PREV. RESULT
	IF	R5,NE,(SP),M.LOOP ;BR IF NOT ALMOST DONE
	JSR	PC,MULF		;OTHWS, MUL. OFF SQUARE TERM
	MOVFLT	-(R5),-(R1)	;PUSH LAST COEFFICIENT
	JSR	PC,ADDF		;ADD TO PREV. RESULT
	JSR	PC,MULF		;MUL BY ORIG. VARIABLE
	TST	(SP)+		;CLEAN UP STACK
M.TT9:	RTS	PC
RPWRF:
MATC1:
MATSMF:
MATSMI:
RPWRI:
MATRD:
MATPRN:
MATPRT:
MATINP:
MATZRO:
MATMC1:
MATID:
MATTRN:
MATINV:
MATSMP:
MATCPY:
MATMUL:
MATADD:
MATSUB:
USINGF	=	PSTJS
	ERRERR	!FATAL
   